Skip to content

Commit

Permalink
Merge pull request #330 from njtierney/shadow-long-error-314
Browse files Browse the repository at this point in the history 
Shadow long error 314
  • Loading branch information
@njtierney
njtierney committed May 1, 2023
2 parents 6dadb07 + c1deb88 commit f85704b
Show file tree
Hide file tree
Showing 5 changed files with 138 additions and 52 deletions.
1 change: 1 addition & 0 deletions NEWS.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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. #314

## Misc

Expand Down
26 changes: 21 additions & 5 deletions R/shadows.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
#'
Expand All @@ -201,22 +207,32 @@ gather_shadow <- function(data){
#'
#' shadow_long(aq_shadow, Ozone, Solar.R)
#'
#' # ensure `value` is numeric
#' shadow_long(aq_shadow, fn_value_transform = as.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_to = "value",
values_transform = list(value = fn_value_transform)
)

longer_one_shade_names <- names(which_are_shade(longer_one))
Expand All @@ -235,9 +251,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)
Expand Down
17 changes: 14 additions & 3 deletions man/shadow_long.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

80 changes: 80 additions & 0 deletions tests/testthat/_snaps/shadow-long.md
View file
Original file line number Diff line number Diff line change
@@ -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

66 changes: 22 additions & 44 deletions tests/testthat/test-shadow-long.R
View file
Original file line number Diff line number Diff line change
@@ -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"))
})

0 comments on commit f85704b

Please sign in to comment.