remove warning for now, split duplicates into several rows

luckinet · Jun 9, 2024 · babb0fa · babb0fa
1 parent 3461032
commit babb0fa
Show file tree

Hide file tree

Showing 3 changed files with 14 additions and 29 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -100,6 +100,7 @@ importFrom(tidyr,pivot_longer)
 importFrom(tidyr,pivot_wider)
 importFrom(tidyr,replace_na)
 importFrom(tidyr,separate)
+importFrom(tidyr,separate_longer_delim)
 importFrom(tidyr,unite)
 importFrom(tidyselect,all_of)
 importFrom(tidyselect,everything)

diff --git a/R/helpers.R b/R/helpers.R
@@ -307,7 +307,7 @@
 #' @return a symmetric list of variables (all with the same dimensions)
 #' @importFrom checkmate assertSetEqual
 #' @importFrom purrr reduce map_int map set_names
-#' @importFrom tidyr pivot_longer pivot_wider fill separate
+#' @importFrom tidyr pivot_longer pivot_wider fill separate separate_longer_delim
 #' @importFrom dplyr distinct select bind_cols if_any full_join
 #' @importFrom tidyselect all_of everything
 #' @importFrom rlang `:=`
@@ -444,21 +444,22 @@
           valueNames <- names(newObs)[!names(newObs) %in% c(idNames, "key")]
         }
 
-        dupObs <- newObs %>%
-          pivot_wider(names_from = "key",
-                      values_from = all_of(valueNames),
-                      values_fn = length) %>%
-          mutate(row = row_number()) %>%
-          filter(if_any(all_of(obsNames), ~ . != 1))
-
-        if(dim(dupObs)[1] != 0){
-          warning("rows(", paste0(dupObs$row, collapse = ", "), ") are summarised from several values.", call. = FALSE)
-        }
+        # dupObs <- newObs %>%
+        #   pivot_wider(names_from = "key",
+        #               values_from = all_of(valueNames),
+        #               values_fn = length) %>%
+        #   mutate(row = row_number()) %>%
+        #   filter(if_any(all_of(obsNames), ~ . != 1))
+        #
+        # if(dim(dupObs)[1] != 0){
+        #   warning("rows(", paste0(dupObs$row, collapse = ", "), ") are summarised from several values.", call. = FALSE)
+        # }
 
         newObs <- newObs %>%
           pivot_wider(names_from = "key",
                       values_from = all_of(valueNames),
-                      values_fn = list)
+                      values_fn = ~ paste(.x, collapse = " | ")) |>
+          separate_longer_delim(cols = all_of(obsNames), delim = " | ")
 
         if(length(wideID) > 1){
           newObs <- newObs %>%

diff --git a/tests/testthat/test-04_listed_measured.R b/tests/testthat/test-04_listed_measured.R
@@ -35,23 +35,6 @@ test_that("listed observed variable", {
   out <- reorganise(input = input, schema = schema)
   expect_equal(names(out), c("territories", "year", "commodities", "HARV", "PROD"))
 
-  # keep duplicated observations (perhaps for a good reason)
-  input <- tabs2shift$listed_column
-  input <- bind_rows(input, input[c(17:18),])
-
-  schema <-
-    setIDVar(name = "territories", columns = 1) %>%
-    setIDVar(name = "year", columns = 2) %>%
-    setIDVar(name = "commodities", columns = 3) %>%
-    setObsVar(name = "harvested", columns = 7,
-              key = 6, value = "harvested") %>%
-    setObsVar(name = "production", columns = 7,
-              key = 6, value = "production")
-
-  expect_warning(out <- reorganise(input = input, schema = schema))
-  expect_tibble(x = out, nrows = 8, ncols = 5)
-  expect_true(all(out$production[7:8] == c(4424, 4444)))
-
 })