tidyverse:所有可能的变量组合的列联表

tidyverse: Contingecy tables for all possible combinatin of variables

以下代码给出了所有可能的变量组合的列联表。

Data <- esoph[ , 1:3]

library(plyr)
combos <- combn(ncol(Data),2)
combos
#>      [,1] [,2] [,3]
#> [1,]    1    1    2
#> [2,]    2    3    3

TableFn <- function(x) {
  Table <- table(Data[, x[1]], Data[, x[2]])
  return(Table)
}

alply(.data=combos, .margins=2, .fun=TableFn, .expand=TRUE)
#> $`1`
#>        
#>         0-39g/day 40-79 80-119 120+
#>   25-34         4     4      3    4
#>   35-44         4     4      4    3
#>   45-54         4     4      4    4
#>   55-64         4     4      4    4
#>   65-74         4     3      4    4
#>   75+           3     4      2    2
#> 
#> $`2`
#>        
#>         0-9g/day 10-19 20-29 30+
#>   25-34        4     4     3   4
#>   35-44        4     4     4   3
#>   45-54        4     4     4   4
#>   55-64        4     4     4   4
#>   65-74        4     4     4   3
#>   75+          4     4     1   2
#> 
#> $`3`
#>            
#>             0-9g/day 10-19 20-29 30+
#>   0-39g/day        6     6     5   6
#>   40-79            6     6     6   5
#>   80-119           6     6     4   5
#>   120+             6     6     5   4
#> 
#> attr(,"split_type")
#> [1] "array"
#> attr(,"split_labels")
#>   X1
#> 1  1
#> 2  2
#> 3  3

现在想从 janitor 获得与 tidyversetabyl 相同的结果。任何提示!!!

library(janitor)
#> 
#> Attaching package: 'janitor'
#> The following objects are masked from 'package:stats':
#> 
#>     chisq.test, fisher.test
Data %>% 
  tabyl(agegp, alcgp)
#>  agegp 0-39g/day 40-79 80-119 120+
#>  25-34         4     4      3    4
#>  35-44         4     4      4    3
#>  45-54         4     4      4    4
#>  55-64         4     4      4    4
#>  65-74         4     3      4    4
#>    75+         3     4      2    2


    TableFn2 <- function(x) {
      Table <- tabyl(Data[, x[1]], Data[, x[2]])
      return(Table)
    }

   purrr::pmap(data.frame(combos), ~TableFn2(c(...)))

Error in show_na && sum(is.na(result[[1]])) > 0 : 
  invalid 'x' type in 'x && y

这是一个使用 purrr::pmap

的选项
library(janitor)
combos <- data.frame(t(combn(names(Data),2)), stringsAsFactors = FALSE)
purrr::pmap(combos, ~tabyl(Data, !!sym(.x), !!sym(.y))) #or change .x, .y with ..1, ..2, etc
[[1]]
 agegp 0-39g/day 40-79 80-119 120+
 25-34         4     4      3    4
 35-44         4     4      4    3
 45-54         4     4      4    4
 55-64         4     4      4    4
 65-74         4     3      4    4
   75+         3     4      2    2

[[2]]
 agegp 0-9g/day 10-19 20-29 30+
 25-34        4     4     3   4
 35-44        4     4     4   3
 45-54        4     4     4   4
 55-64        4     4     4   4
 65-74        4     4     4   3
   75+        4     4     1   2

[[3]]
     alcgp 0-9g/day 10-19 20-29 30+
 0-39g/day        6     6     5   6
     40-79        6     6     6   5
    80-119        6     6     4   5
      120+        6     6     5   4

如果我没理解错的话

df <- mtcars[, 8:11]
combos <- combn(names(df), 2)

Rows <- combos[1, ] %>% purrr::set_names()
Cols <- combos[2, ] %>% purrr::set_names()

TablFn <- function(x, y) {
  df %>% tabyl(!!sym(x), !!sym(y))
}

map2(Rows, Cols, TablFn)