Merge pull request #216 from antaldaniel/daniel-regional

Replacing regional data vignette

DESCRIPTION

@@ -72,7 +72,8 @@ Imports:
     stringr,
     tibble,
     tidyr,
-    regions
+    regions,
+    rlang
 Suggests:
     covr,
     Cairo,
@@ -84,7 +85,8 @@ Suggests:
     rvest,
     testthat,
     tmap,
-    usethis
+    usethis,
+    here
 LazyData: true
 URL: https://ropengov.github.io/eurostat/
 BugReports: https://github.com/ropengov/eurostat/issues

NAMESPACE

@@ -51,6 +51,7 @@ importFrom(readr,read_tsv)
 importFrom(region,validate_nuts_regions)
 importFrom(regions,recode_nuts)
 importFrom(regions,validate_nuts_regions)
+importFrom(rlang,.data)
 importFrom(sf,st_buffer)
 importFrom(sf,st_read)
 importFrom(stringi,stri_extract_first_regex)

NEWS

@@ -1,3 +1,8 @@
+# eurostat 3.7.5
+
+ * Deprecated add_nuts_level, harmonize_geo_code, recode_to_nuts_2016 and recode_to_nuts_2013; these functions were moved to the
+    new package regions. The problem of sub-national geo codes is explained in the new vignette "Mapping Regional Data, Mapping Metadata Problems", which replaces the "Regional data  examples for the eurostat R package" vignette. This is a shared vignette, but the new regions package has more articles on how to work with sub-national data. 
+
 # eurostat 3.7.2
 
  * Non-intersecting sf-geometries in get_eurostat_geospatial (PR by @retostauffer)

R/deprecated_regions_functions.R

@@ -1,6 +1,73 @@
 #' DEPRECATED FUNCTIONS FOR BACKWARD COMPATIBILITY
 #' FUNCTIONS GIVE WARNING AND CALL APPROPRIATE regions FUNCTIONS
 
+#' @title Add the statistical aggregation level to data frame
+#' @description Eurostat regional statistics contain country, and various
+#' regional level information.  In many cases, for example, when mapping,
+#' it is useful to filter out national level data from NUTS2 level regional data,
+#' for example. 
+#' 
+#' This function will be deprecated. Use the more comprehensive
+#' \code{regions::\link[regions]{validate_nuts_regions}} instead.
+#'  
+#' @param dat A data frame or tibble returned by \code{\link{get_eurostat}}.
+#' @param geo_labels A geographical label, defaults to \code{geo}.
+#' @author Daniel Antal
+#' @return a new numeric variable nuts_level with the numeric value of
+#' NUTS level 0 (country), 1 (greater region),
+#' 2 (region), 3 (small region).
+#' @examples
+#'  {
+#'    dat = data.frame (
+#'         geo    = c("FR", "IE04", "DEB1C"), 
+#'         values = c(1000, 23, 12)
+#'    )
+#'    
+#'    add_nuts_level(dat)
+#'  }
+#'  
+#' @importFrom dplyr mutate case_when
+#' @importFrom rlang .data
+#' @importFrom magrittr %>%
+#'  
+#' @export
+
+add_nuts_level <- function (dat, geo_labels = "geo") {
+
+  message ("This function will be deprecated. Use regions::validate_nuts_regions() instead.") 
+
+  if ( any(c("character", "factor") %in% class(dat)) ) {
+    input <- 'label'
+    geo <- dat 
+    dat <- data.frame( geo = as.character(geo), 
+                       stringsAsFactors = FALSE)
+  } else { 
+    input <- "not_label" 
+  }
+
+
+  if ( "data.frame" %in% class(dat) ) {
+    if ( ! geo_labels %in% names(dat) ) {
+      stop ( "Regional labelling variable '",
+             geo_labels,
+             "' is not found in the data frame.")
+    }
+
+    dat <- dat %>% 
+      dplyr::mutate ( nuts_level = dplyr::case_when (
+        nchar(as.character(.data$geo)) == 2  ~ 0,
+        nchar(as.character(.data$geo)) == 3  ~ 1,
+        nchar(as.character(.data$geo)) == 4  ~ 2,
+        nchar(as.character(.data$geo)) == 5  ~ 3,
+        TRUE ~ NA_real_
+      ))
+  } 
+
+  if ( input == "label" ) {
+    as.numeric(dat$nuts_level)
+  } else dat
+
+}
 
 #' @title Harmonize NUTS region codes that changed with the \code{NUTS2016} definition
 #' @description Eurostat mixes \code{NUTS2013} and \code{NUTS2016} geographic

tests/testthat/test_regional.R

@@ -16,11 +16,25 @@ test_regional_codes <- data.frame (
               "Recoded in NUTS2016"
   )) 
 
+
+
+dat = data.frame (
+  geo    = c("FR", "IE04", "DEB1C"), 
+  values = c(1000, 23, 12)
+)
+
 test_that("deprecation warning works", {
   expect_warning (recode_to_nuts_2013(test_regional_codes))
   expect_warning (recode_to_nuts_2016(test_regional_codes))
+  expect_message(add_nuts_level(dat))
 })
 
+suppressMessages(
+  test_that("add_nuts_level works", {
+    expect_equal(add_nuts_level(dat)$nuts_level, c(0,2,3))
+  })
+)
+
 
 test_that("Recoding gives correct results",{
 
@@ -33,8 +47,6 @@ test_that("Recoding gives correct results",{
 
   suppressWarnings(try_recode_2013 <- recode_to_nuts_2013(test_harmonized))
 
-  suppressWarnings(try_recode_2016 <- recode_to_nuts_2016(test_harmonized))
-
   lookup_code16 <- test_harmonized %>%
     filter ( geo  == "FR243") %>%
     select ( code16 ) %>% unlist() %>% as.character()