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
获得与 tidyverse
和 tabyl
相同的结果。任何提示!!!
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)
以下代码给出了所有可能的变量组合的列联表。
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
获得与 tidyverse
和 tabyl
相同的结果。任何提示!!!
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)