Fix bug with shadow_long not working when gathering variables of mi…

…xed type. - Fix involves specifying a value transform, which defaults to character. - also update some shadow_long tests to use snapshots - Resolves #314
njtierney · May 1, 2023 · d40bfdc · d40bfdc
1 parent ee8340a
commit d40bfdc
Show file tree

Hide file tree

Showing 5 changed files with 135 additions and 52 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -8,6 +8,7 @@
 - `geom_miss_point()` works with `shape` argument #290
 - fix bug with `all_complete`, which was implemented as `!anyNA(x)` but should be `all(complete.cases(x))`.
 - correctly implement `any_na()` (and `any_miss()`) and `any_complete()`. Rework examples to demonstrate workflow for finding complete variables.
+- Fix bug with `shadow_long` not working when gathering variables of mixed type. Fix involves specifying a value transform, which defaults to character.
 
 ## Misc
 

diff --git a/R/shadows.R b/R/shadows.R
@@ -181,18 +181,24 @@ gather_shadow <- function(data){
 #' Reshape shadow data into a long format
 #'
 #' Once data is in `nabular` form, where the shadow is bound to the data, it
-#'     can be useful to reshape it into a long format with the columns
+#'     can be useful to reshape it into a long format with the shadow columns
+#'     in a separate grouping - so you have `variable`, `value`, and
+#'     `variable_NA` and `value_NA`.
 #'
 #' @param shadow_data a data.frame
 #' @param ... bare name of variables that you want to focus on
+#' @param fn_value_transform function to transform the "value" column. Default
+#'   is NULL, which defaults to `as.character`. Be aware that `as.numeric` may
+#'   fail for some instances if it cannot coerce the value into numeric. See
+#'   the examples.
 #' @param only_main_vars logical - do you want to filter down to main variables?
 #'
 #' @return data in long format, with columns `variable`, `value`, `variable_NA`, and `value_NA`.
 #' @export
 #'
 #' @examples
 #'
-#' aq_shadow <- bind_shadow(airquality)
+#' aq_shadow <- nabular(airquality)
 #'
 #' shadow_long(aq_shadow)
 #'
@@ -201,23 +207,31 @@ gather_shadow <- function(data){
 #'
 #' shadow_long(aq_shadow, Ozone, Solar.R)
 #'
+#' # ensure `value` is numeric
+#' shadow_long(aq_shadow, Ozone, Solar.R, fn_value_transform = as.numeric)
+#'
 #'
 shadow_long <- function(
   shadow_data,
   ...,
+  fn_value_transform = NULL,
   only_main_vars = TRUE
     ) {
 
   test_if_null(shadow_data)
   test_if_any_shade(shadow_data)
 
+  if (is.null(fn_value_transform)) {
+    fn_value_transform <- as.character
+  }
+
   shadow_data_names <- names(which_are_shade(shadow_data))
   longer_one <- tidyr::pivot_longer(
     shadow_data,
     cols = -dplyr::one_of(shadow_data_names),
     names_to = "variable",
     values_to = "value",
-    values_transform = list(value = as.character)
+    values_transform = list(value = fn_value_transform)
   )
 
   longer_one_shade_names <- names(which_are_shade(longer_one))
@@ -236,9 +250,9 @@ shadow_long <- function(
   }
 
   if (!missing(...)) {
-    vars <- purrr::map(ensyms(...), as_string)
+    df_vars <- purrr::map_chr(ensyms(...), as_string)
     gathered_df <- gathered_df %>%
-      dplyr::filter(variable %in% vars)
+      dplyr::filter(variable %in% df_vars)
   }
 
   return(gathered_df)

diff --git a/man/shadow_long.Rd b/man/shadow_long.Rd
diff --git a/tests/testthat/_snaps/shadow-long.md b/tests/testthat/_snaps/shadow-long.md
@@ -0,0 +1,80 @@
+# shadow_long returns the right dimensions and names etc
+
+    Code
+      shadow_long(ocean_shadow)
+    Output
+      # A tibble: 5,888 x 4
+         variable   value        variable_NA   value_NA
+         <chr>      <chr>        <chr>         <fct>   
+       1 year       1997         year_NA       !NA     
+       2 latitude   0            latitude_NA   !NA     
+       3 longitude  -110         longitude_NA  !NA     
+       4 sea_temp_c 27.59000015  sea_temp_c_NA !NA     
+       5 air_temp_c 27.14999962  air_temp_c_NA !NA     
+       6 humidity   79.59999847  humidity_NA   !NA     
+       7 wind_ew    -6.400000095 wind_ew_NA    !NA     
+       8 wind_ns    5.400000095  wind_ns_NA    !NA     
+       9 year       1997         year_NA       !NA     
+      10 latitude   0            latitude_NA   !NA     
+      # i 5,878 more rows
+
+# shadow_long works gives the classes with function value transform
+
+    Code
+      shadow_long(ocean_shadow, fn_value_transform = as.numeric)
+    Output
+      # A tibble: 5,888 x 4
+         variable     value variable_NA   value_NA
+         <chr>        <dbl> <chr>         <fct>   
+       1 year       1997    year_NA       !NA     
+       2 latitude      0    latitude_NA   !NA     
+       3 longitude  -110    longitude_NA  !NA     
+       4 sea_temp_c   27.6  sea_temp_c_NA !NA     
+       5 air_temp_c   27.1  air_temp_c_NA !NA     
+       6 humidity     79.6  humidity_NA   !NA     
+       7 wind_ew      -6.40 wind_ew_NA    !NA     
+       8 wind_ns       5.40 wind_ns_NA    !NA     
+       9 year       1997    year_NA       !NA     
+      10 latitude      0    latitude_NA   !NA     
+      # i 5,878 more rows
+
+# shadow_long returns right dimensions, names, etc when filtered
+
+    Code
+      shadow_long(ocean_shadow, air_temp_c, humidity)
+    Output
+      # A tibble: 1,472 x 4
+         variable   value       variable_NA   value_NA
+         <chr>      <chr>       <chr>         <fct>   
+       1 air_temp_c 27.14999962 air_temp_c_NA !NA     
+       2 humidity   79.59999847 humidity_NA   !NA     
+       3 air_temp_c 27.02000046 air_temp_c_NA !NA     
+       4 humidity   75.80000305 humidity_NA   !NA     
+       5 air_temp_c 27          air_temp_c_NA !NA     
+       6 humidity   76.5        humidity_NA   !NA     
+       7 air_temp_c 26.93000031 air_temp_c_NA !NA     
+       8 humidity   76.19999695 humidity_NA   !NA     
+       9 air_temp_c 26.84000015 air_temp_c_NA !NA     
+      10 humidity   76.40000153 humidity_NA   !NA     
+      # i 1,462 more rows
+
+# shadow_long returns right dimensions, names, etc when filtered with function value transform
+
+    Code
+      shadow_long(ocean_shadow, air_temp_c, humidity, fn_value_transform = as.numeric)
+    Output
+      # A tibble: 1,472 x 4
+         variable   value variable_NA   value_NA
+         <chr>      <dbl> <chr>         <fct>   
+       1 air_temp_c  27.1 air_temp_c_NA !NA     
+       2 humidity    79.6 humidity_NA   !NA     
+       3 air_temp_c  27.0 air_temp_c_NA !NA     
+       4 humidity    75.8 humidity_NA   !NA     
+       5 air_temp_c  27   air_temp_c_NA !NA     
+       6 humidity    76.5 humidity_NA   !NA     
+       7 air_temp_c  26.9 air_temp_c_NA !NA     
+       8 humidity    76.2 humidity_NA   !NA     
+       9 air_temp_c  26.8 air_temp_c_NA !NA     
+      10 humidity    76.4 humidity_NA   !NA     
+      # i 1,462 more rows
+
diff --git a/tests/testthat/test-shadow-long.R b/tests/testthat/test-shadow-long.R
@@ -1,52 +1,30 @@
-aq_shadow <- nabular(airquality)
+ocean_shadow <- nabular(oceanbuoys)
 
-aq_sh_long <- shadow_long(aq_shadow)
-
-test_that("shadow_long returns data of the right dimensions", {
-  expect_equal(dim(aq_sh_long), c(918, 4))
-})
-
-test_that("shadow_long returns data with the right names", {
-  expect_equal(names(aq_sh_long),
-               c("variable", "value", "variable_NA", "value_NA"))
-})
-library(purrr)
-
-test_that("shadow_long returns right data class", {
-  expect_equal(as.character(map_chr(aq_sh_long, class)),
-               c("character", "numeric", "character", "factor"))
+test_that("shadow_long returns the right dimensions and names etc", {
+  expect_snapshot(
+    shadow_long(ocean_shadow)
+  )
 })
 
-aq_sh_long_ozone <- shadow_long(aq_shadow, Ozone)
-
-test_that("shadow_long returns data with right dimensions when filtered", {
-  expect_equal(dim(aq_sh_long_ozone), c(153, 4))
+test_that("shadow_long works gives the classes with function value transform", {
+  expect_snapshot(
+    shadow_long(ocean_shadow,
+                fn_value_transform = as.numeric)
+  )
 })
 
-test_that("shadow_long returns data with right names when filtered", {
-  expect_equal(names(aq_sh_long_ozone),
-               c("variable", "value", "variable_NA", "value_NA"))
+test_that("shadow_long returns right dimensions, names, etc when filtered", {
+  expect_snapshot(
+    shadow_long(ocean_shadow, air_temp_c, humidity)
+  )
 })
 
-test_that("shadow_long returns right data class when filtered", {
-  expect_equal(as.character(map_chr(aq_sh_long_ozone, class)),
-               c("character", "numeric", "character", "factor"))
+test_that("shadow_long returns right dimensions, names, etc when filtered with function value transform", {
+  expect_snapshot(
+    shadow_long(ocean_shadow,
+                air_temp_c,
+                humidity,
+                fn_value_transform = as.numeric
+  )
+  )
 })
-
-
-aq_sh_long_ozone_solar <- shadow_long(aq_shadow, Ozone, Solar.R)
-
-test_that("shadow_long returns data with right dimensions when filtered", {
-  expect_equal(dim(aq_sh_long_ozone_solar), c(306, 4))
-})
-
-test_that("shadow_long returns data with right names when filtered", {
-  expect_equal(names(aq_sh_long_ozone_solar),
-               c("variable", "value", "variable_NA", "value_NA"))
-})
-
-test_that("shadow_long returns right data class when filtered", {
-  expect_equal(as.character(map_chr(aq_sh_long_ozone_solar, class)),
-               c("character", "numeric", "character", "factor"))
-})
-