bug fix: nuts_aggregate adds codes of all versions to check missings which yields in NAs even though complete

Author: AAoritz

R/nuts_aggregate.R

@@ -113,6 +113,7 @@ nuts_aggregate <- function(data,
     if (nr_nuts_codes_recognized == 0)
       cli_abort("NUTS codes are not recognized and cannot be converted.")
 
+
     # CONVERSION POSSIBLE
     #----------------------
     # CONVERSION BETWEEN DIFFERENT NUTS LEVELS
@@ -138,6 +139,7 @@ nuts_aggregate <- function(data,
     n_rows_dropped <- data[["n_rows_dropped"]]
     message_multiple_versions <- data[["message_multiple_versions"]]
     data <- data[["data"]]
+    from_version_string <- data$from_version[1]
 
     # Prepare join with regional indicator stocks such that missing NUTS codes within groups are kept
     # - Create group structure
@@ -149,6 +151,9 @@ nuts_aggregate <- function(data,
     # - Prepare stocks from cross_walks for subsetting and matching
     cross_walks <- get("cross_walks")
     stocks <- cross_walks %>%
+      # Subset to desired version
+      filter(.data$from_version == from_version_string) %>%
+      # Keep only stocks
       filter(.data$from_version == .data$to_version) %>%
       select(-c("from_version", "to_version", "to_code")) %>%
       distinct(.data$from_code, .keep_all = TRUE)
@@ -162,7 +167,6 @@ nuts_aggregate <- function(data,
       stocks_groups <- stocks %>% cross_join(groups)
     }
 
-
     # - Subset cross walks to desired countries, levels and versions
     stocks_groups <- stocks_groups %>%
       rename(from_level = .data$level) %>%
@@ -184,7 +188,7 @@ nuts_aggregate <- function(data,
       message_missing_codes <- c("x" = "{.blue {.red Missing} NUTS codes in data. No values are calculated for regions associated with missing NUTS codes. Ensure that the input data is complete.}")
 
     } else if (nrow(missing) == 0) {
-      message_missing_codes <- c("v" = "{.blue No {.red missing} NUTS codes.}")
+      message_missing_codes <- c("v" = "{.blue No missing NUTS codes.}")
     }
     rm(missing)
 

tests/testthat/test-nuts_aggregate.R

@@ -133,6 +133,45 @@ test_that("NUTS codes already at level 2", {
 
 # Run positive tests
 #---------------------
+test_that("No missing NUTS in output, aggregation should go smooth", {
+  expect_equal(
+    all_nuts_codes %>%
+      filter(country == "France", version == 2021, nchar(code) == 4) %>%
+      select(nuts_code = code) %>%
+      mutate(val = rnorm(nrow(.), 0, 1)) %>%
+      nuts_classify(nuts_code = "nuts_code") %>%
+      nuts_aggregate(
+        to_level = 1,
+        variables = c('val' = 'absolute')
+      ) %>%
+      filter(is.na(val)) %>%
+      nrow(.),
+    0
+  )
+})
+
+test_that("Converter output spits out correct names", {
+  expect_equal(
+    manure %>%
+      filter(nchar(geo) == 5) %>%
+      filter(!grepl("EU|ME|ZZ", geo)) %>%
+      nuts_classify(
+        nuts_code = "geo",
+        group_vars = c("indic_ag", "time")
+      ) %>%
+      nuts_aggregate(
+        to_level = 2,
+        variables = c("values" = "absolute")
+      ) %>%
+      names(.),
+    c("to_code", "country", "indic_ag", "time", "values")
+  )
+})
+
+
+
+
+
 test_that("Converter output spits out correct names", {
   expect_equal(
     manure %>%
@@ -308,7 +347,7 @@ test_that("Feeding multiple NUTS versions within groups. Option most frequent.",
                 ) %>%
                 filter(!is.na(values)) %>%
                 dim(),
-              c(52, 4)
+              c(46, 4)
             )
           })