Merge pull request runapp-aus#102 from RWParsons/dev-read-cg-tables

read cg tables

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: strayr
 Type: Package
 Title: Ready-to-use Australian common structures and classifications and tools for working with them
-Version: 0.2.2
+Version: 0.2.2.9000
 Authors@R: c(person("Will", "Mackey", email = "[email protected]", role = c("aut", "cre")),
         person("Matt", "Johnson", email = "[email protected]", role = c("aut")),
         person("David", "Diviny", email = "[email protected]", role = c("aut")),
@@ -10,7 +10,8 @@ Authors@R: c(person("Will", "Mackey", email = "[email protected]", role = c("au
         person("William", "Lai", role = c("aut")),
         person("Benjamin", "Wee", role = c("aut")),
         person("Carlos", "Yanez", role = "ctb"),
-        person("Bas", "Latcham", role = "ctb")
+        person("Bas", "Latcham", role = "ctb"),
+        person("Rex", "Parsons", role = "ctb", comment = c(ORCID = "0000-0002-6053-8174"))
         )
 Maintainer: Will Mackey <[email protected]>
 License: GPL-3

NAMESPACE

@@ -13,6 +13,7 @@ export(get_seifa_index_sheet)
 export(is_holiday)
 export(parse_income_range)
 export(read_absmap)
+export(read_correspondence_tbl)
 export(strayr)
 export(strip_year_suffix)
 import(readxl)

NEWS.md

@@ -1,3 +1,7 @@
+# strayr (development version)
+* `create read_correspondence_tbl()` reads correspondence tables from
+`absmapsdata` similarly to `read_absmap()`
+
 # strayr 0.2.2
 * `anzsco2022` updated to reflect changes made by the ABS
 

R/read_correspondence_tbl.R

@@ -0,0 +1,63 @@
+#' Read in ASGC/ASGS 2016 population-weighted correspondence tables from the ABS.
+#' @source <https://data.gov.au/dataset/ds-dga-23fe168c-09a7-42d2-a2f9-fd08fbd0a4ce>
+#'
+#' @param from_area The area you want to correspond FROM (ie the areas your data are currently in). For example: "sa1", "sa2, "sa3", "sa4".
+#' @param from_year The year you want to correspond FROM. For example: 2011, 2016.
+#' @param to_area The area you want to correspond TO (ie the areas you want your data to be in).
+#' @param to_year The year you want to correspond TO.
+#' @param export_dir path to a directory to store the desired sf object. \code{tempdir()} by default.
+#'
+#' @return A \code{tibble} object.
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' sa4_corr <- read_correspondence_tbl("sa4", 2011, "sa4", 2016)
+#' lga2011_to_2018 <- read_correspondence_tbl("LGA", 2011, "LGA", 2018)
+#' }
+read_correspondence_tbl <- function(from_area,
+                                    from_year,
+                                    to_area,
+                                    to_year,
+                                    export_dir = tempdir()) {
+  if (!dir.exists(export_dir)) {
+    stop("export_dir provided does not exist: ", export_dir)
+  }
+
+  url <- "https://github.com/wfmackey/absmapsdata/raw/master/R/sysdata.rda"
+
+  # download to temporary file
+  out_path <- file.path(export_dir, "cg_tables.rda")
+
+  if (!file.exists(out_path)) {
+    tryCatch(
+      download.file(url,
+                    destfile = out_path,
+                    mode = "wb"),
+      error = "Download failed. Check that you have access to the internet and that your requested object is available at https://github.com/wfmackey/absmapsdata/tree/master/data"
+    )
+  } else {
+    message("Reading file found in ", export_dir)
+  }
+
+  load(out_path)
+
+  filename <- paste(
+    "CG",
+    toupper(from_area), from_year,
+    toupper(to_area), to_year,
+    sep = "_"
+  )
+
+  cg_tbl <- try(get(filename))
+
+  if (inherits(cg_tbl, "try-error")) {
+    message("The following correspondence tables are available:")
+    for(obj in ls()[str_detect(ls(), "^CG_")]) {
+      message(obj)
+    }
+    stop("Correspondence table not available.")
+  }
+
+  cg_tbl
+}

tests/testthat/test-read_correspondence_tbl.R

@@ -0,0 +1,42 @@
+test_that("read_correspondence_tbl() retrieves objects", {
+  skip_on_cran()
+  skip_if_offline()
+
+  sa4_corr <- read_correspondence_tbl("sa4", 2011, "sa4", 2016)
+  expect_s3_class(sa4_corr, "tbl")
+  expect_identical(
+    names(sa4_corr),
+    c("SA4_CODE_2011",
+      "SA4_NAME_2011",
+      "SA4_CODE_2016",
+      "SA4_NAME_2016",
+      "ratio",
+      "PERCENTAGE")
+  )
+})
+
+test_that("read_correspondence_tbl() input checking works", {
+  expect_error(
+    read_correspondence_tbl("sa4", 2011, "sa4", 2016, export_dir = "this-doesnt-exist"),
+    regexp = "does not exist"
+  )
+})
+
+test_that("caching for read_correspondence_tbl() works", {
+  skip_on_cran()
+  skip_if_offline()
+
+  read_correspondence_tbl("sa4", 2011, "sa4", 2016)
+  # will be cached
+  expect_message(read_correspondence_tbl("sa4", 2011, "sa4", 2016), regexp = "Reading")
+
+
+  new_dir <- file.path(tempdir(), "test-data")
+  dir.create(new_dir)
+  # will have to download again
+  expect_silent(read_correspondence_tbl("sa4", 2011, "sa4", 2016, export_dir = new_dir))
+  # will be cached
+  expect_message(read_correspondence_tbl("sa4", 2011, "sa4", 2016, export_dir = new_dir))
+
+  unlink(new_dir)
+})