Skip to content

Commit

Permalink
Handle 2-3 ways tabyl as well.
Browse files Browse the repository at this point in the history
  • Loading branch information
olivroy committed May 23, 2024
1 parent 89cdb72 commit cc9edbb
Show file tree
Hide file tree
Showing 2 changed files with 19 additions and 6 deletions.
22 changes: 17 additions & 5 deletions R/tabyl.R
Original file line number Diff line number Diff line change
Expand Up @@ -244,10 +244,11 @@ tabyl_2way <- function(dat, var1, var2, show_na = TRUE, show_missing_levels = TR
result <- result[c(setdiff(names(result), "NA_"), "NA_")]
}


result %>%
data.frame(., check.names = FALSE) %>%
as_tabyl(axes = 2, row_var_name = names(dat)[1], col_var_name = names(dat)[2])
row_var_name <- names(dat)[1]
col_var_name <- names(dat)[2]
names(result)[1] <- attr(dat[, 1], "label", exact = TRUE) %||% names(result)[1]
data.frame(result, check.names = FALSE) %>%
as_tabyl(axes = 2, row_var_name = row_var_name, col_var_name = col_var_name)
}


Expand All @@ -256,6 +257,10 @@ tabyl_3way <- function(dat, var1, var2, var3, show_na = TRUE, show_missing_level
dat <- dplyr::select(dat, !!var1, !!var2, !!var3)
var3_numeric <- is.numeric(dat[[3]])

# Sometimes, attributes can be dropped with transformation.
var1_label <- attr(dat[, 1], "label", exact = TRUE)
var2_label <- attr(dat[, 2], "label", exact = TRUE)

# Keep factor levels for ordering the list at the end
if (is.factor(dat[[3]])) {
third_levels_for_sorting <- levels(dat[[3]])
Expand Down Expand Up @@ -283,7 +288,14 @@ tabyl_3way <- function(dat, var1, var2, var3, show_na = TRUE, show_missing_level
dat[[2]] <- as.factor(dat[[2]])
}

result <- split(dat, dat[[rlang::quo_name(var3)]]) %>%
result <- split(dat, dat[[rlang::quo_name(var3)]])
# split() drops attributes, so we manually add back the 1st variable attribute.
result <- lapply(result, function(x) {
attr(x[[1]], "label") <- var1_label
attr(x[[2]], "label") <- var2_label
x
})
result <- result %>%
purrr::map(tabyl_2way, var1, var2, show_na = show_na, show_missing_levels = show_missing_levels) %>%
purrr::map(reset_1st_col_status, col1_class, col1_levels) # reset class of var in 1st col to its input class, #168

Expand Down
3 changes: 2 additions & 1 deletion tests/testthat/test-tabyl.R
Original file line number Diff line number Diff line change
Expand Up @@ -400,9 +400,10 @@ test_that("tabyl works with label attributes (#394)", {
attr(mt_label$cyl, "label") <- "Number of cyl"
tab <- tabyl(mt_label, cyl)
expect_named(tab, c("Number of cyl", "n", "percent"))

tab2 <- tabyl(mt_label, cyl, am)
expect_named(tab2, c("Number of cyl", "0", "1"))
tab3 <- tabyl(mt_label, cyl, am, vs)
expect_equal(names(tab3[[1]])[1], "Number of cyl")
})

test_that("tabyl works with ordered 1st variable, #386", {
Expand Down

0 comments on commit cc9edbb

Please sign in to comment.