tidyverse: croiser les tableaux d'une variable avec toutes les autres variables dans data.frame

En supposant que nous ayons besoin d'une table par paires avec 'gender'

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

Update

La xtable :: xtableList nécessite que les noms soient identiques les éléments list . Pour ce faire, changez le nom de la première colonne de la même manière dans les éléments list , puis créez une colonne d'identifiant

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
#...

En utilisant uniquement data.table (et un %>%):

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

Les colonnes de liste dans starwars ajoutent de la complexité, mais voici un exemple avec mtcars : crosstab cyl par rapport à toutes les autres variables.

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

Renvoie une liste de tableaux croisés. cyl x am, cyl x carb, etc.:

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

Si vous voulez continuer à manipuler ces données. cadres, vous pouvez trouver cette option de titre plus conviviale:

$`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

...

Ce qui vous donne:

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))

tably prend les noms comme arguments et vous lui avez transmis un vecteur.

Si vous utilisez imap vous aurez accès au nom de la colonne, que vous pouvez convertir en symbole, et comme concierge prend en charge la quasi-citation, vous pouvez write:

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)

Fait intéressant, tabyl.data.frame appelle une fonction non exportée qui fonctionne sur les symboles donc en l'appelant directement, nous pouvons ignorer la suppression des guillemets et utiliser base R.

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

Pour le faire fonctionner avec la suggestion de xtable @ akrun fonctionne également ici:

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