tidyverse: Cross tables of one variable with all other variables in data.frame

Question

I want to make cross table of a variable with all other variables in the data.frame.

library(tidyverse)
library(janitor)

humans <- starwars %>%
  filter(species == "Human")

humans %>%
  janitor::tabyl(gender, eye_color)



gender blue blue-gray brown dark hazel yellow
 female    3         0     5    0     1      0
   male    9         1    12    1     1      2

humans %>%
  dplyr::select_if(is.character) %>%
  dplyr::select(-name, -gender) %>%
  purrr::map(.f = ~janitor::tabyl(dat = humans, gender, .x))

Error: Unknown columns `blond`, `none`, `brown`, `brown, grey`, `brown` and ... 
Call `rlang::last_error()` to see a backtrace

Answer 1

tably takes names as arguments and you passed a vector to it.

If you use imap you'll have access to the name of the column, that you can convert to a symbol, and as janitor supports quasi-quotation you can write:

humans %>%
  select_if(is.character) %>%
  select(-name, -gender) %>%
  imap(.f = ~janitor::tabyl(dat = humans, !!sym(.y), gender))
#$`hair_color`
#     hair_color female male
#         auburn      1    0
#   auburn, grey      0    1
#  auburn, white      0    1
#          black      1    7
#          blond      0    3
#          brown      6    8
#    brown, grey      0    1
#           grey      0    1
#           none      0    3
#          white      1    1
# 
# $skin_color
#  skin_color female male
#        dark      0    4
#        fair      3   13

Interestingly tabyl.data.frame calls an unexported function that works on symbols so by calling it directly we can skip the unquoting and use base R.

cols <- setdiff(names(Filter(is.character,humans)), c("name","gender"))
lapply(cols, function(x) janitor:::tabyl_2way(humans, as.name(x), quote(gender)))
# [[1]]
#     hair_color female male
#         auburn      1    0
#   auburn, grey      0    1
#  auburn, white      0    1
#          black      1    7
#          blond      0    3
#          brown      6    8
#    brown, grey      0    1
#           grey      0    1
#           none      0    3
#          white      1    1
# 
# [[2]]
#  skin_color female male
#        dark      0    4

To make it work with xtable @akrun's suggestion works here as well :

humans %>%
  select_if(is.character) %>%
  select(-name, -gender) %>%
  imap(.f = ~tabyl(dat = humans, !!sym(.y), gender) %>% rename_at(1,~"x")) %>%
  xtableList

or

cols <- setdiff(names(Filter(is.character,humans)), c("name","gender"))
l <- lapply(cols, function(x) {
  res <- janitor:::tabyl_2way(humans, as.name(x), quote(gender))
  names(res)[1] <- "x"
  res
})
xtableList(l)

Answer 2

Assuming that we need pairwise table with 'gender'

humans %>%
  dplyr::select_if(is.character) %>%
  dplyr::select(-name, -gender) %>%
  imap(~ tibble(!! .y := .x) %>% 
             mutate(gender = humans[['gender']]) %>% 
             janitor::tabyl(!!rlang::sym(names(.)[1]), gender))
#$hair_color
#    hair_color female male
#        auburn      1    0
#  auburn, grey      0    1
# auburn, white      0    1
#         black      1    7
#         blond      0    3
#        brown      6    8
#  brown, grey      0    1
#         grey      0    1
#         none      0    3
#        white      1    1

#$skin_color
# skin_color female male
#       dark      0    4
#       fair      3   13
#      light      6    5
#...

Update

The xtable::xtableList requires names to be same across the list elements. To make that happen, change the first column name same across the list elements and then create an identifier column

library(xtable)
humans %>%
 dplyr::select_if(is.character) %>%
 dplyr::select(-name, -gender) %>%
 imap(~ tibble(!! .y := .x) %>% 
         mutate(gender = humans[['gender']]) %>% 
         janitor::tabyl(!!rlang::sym(names(.)[1]), gender) %>%  
         mutate(colNname = .y) %>% 
         rename_at(1, ~ 'Variable')) %>%
 xtableList

Answer 3

Using only data.table (and one %>%):

library(data.table)
swDT <- data.table(starwars)
setkey(swDT, gender, hair_color)


swDT[species == "Human"
     ][CJ(gender, hair_color, unique =TRUE), .N, .EACHI] %>% 
  dcast(hair_color ~ gender, value.var = "N")


       hair_color female male
 1:        auburn      1    0
 2:  auburn, grey      0    1
 3: auburn, white      0    1
 4:         black      1    7
 5:         blond      0    3
 6:         brown      6    8
 7:   brown, grey      0    1
 8:          grey      0    1
 9:          none      0    3
10:         white      1    1

Answer 4

The list-columns in starwars add complexity, but here's an example with mtcars: crosstab cyl against all other variables.

mtcars %>%
  tidyr::gather(var, value, -cyl) %>%
  janitor::tabyl(cyl, value, var, show_missing_levels = FALSE) %>%
  purrr::map2(.x = ., .y = names(.), ~ janitor::adorn_title(.x, col_name = .y))

Returns a list of crosstabs. cyl x am, cyl x carb, etc. :

$`am`
     am  
 cyl  0 1
   4  3 8
   6  4 3
   8 12 2

$carb
     carb          
 cyl    1 2 3 4 6 8
   4    5 6 0 0 0 0
   6    2 0 0 4 1 0
   8    0 4 3 6 0 1

...

If you will do further manipulation of these data.frames you may find this title option friendlier:

purrr::map2(.x = ., .y = names(.), ~ janitor::adorn_title(.x, col_name = .y, placement = "combined"))

Which gives you:

$vs
 cyl/vs  0  1
      4  1 10
      6  3  4
      8 14  0