以上两个答案都完成了工作，但我在这个上浪费了一些时间，可能是自我隔离变得疯狂。我的第一个想法是使用 janitor::tabyl 就像 tabyl(df, sex, binary1, country) %>% adorn_percentages("row") 一样，它几乎可以满足您的需求。不幸的是，它只喜欢单个裸变量，在purrr::map 链中表现不佳。因此，使用基本的tidyverse 工具，我编写了一个自定义函数来创建一个可以与purrr 很好地配合使用的tibble，然后自学更多关于flextable 的知识，我用它来使输出更好。请注意，您的原始数据不是数据框，因此我更改了该部分。
我的解决方案恕我直言的优点是它具有很强的可扩展性和可修改性。
library(tidyverse)
library(flextable)
#>
#> Attaching package: 'flextable'
#> The following object is masked from 'package:purrr':
#>
#> compose
country <- c('germany','germany','germany','USA','USA','USA','USA','germany','germany','USA')
sex <- c('female','male','male','female','female','female','male','female','female','female')
binary1 <- c(1,1,0,1,0,1,0,0,0,1)
binary2 <- c(0,1,0,1,1,1,0,1,0,1)
binary3 <- c(0,1,1,1,0,1,0,0,0,1)
# make it a true dataframe
df <- as.data.frame(cbind(country,sex,binary1,binary2,binary3))
xtabs3 <- function(data,
x,
y,
z) {
# internal helper function
not_a_factor <- function(x){
!is.factor(x)
}
# capture variable names
xlab <- rlang::as_name(rlang::enquo(x))
ylab <- rlang::as_name(rlang::enquo(y))
zlab <- rlang::as_name(z)
# create temp local dataframe
data <-
dplyr::select(
.data = data,
x = {{ x }},
y = {{ y }},
z = {{ z }}
)
# calculate counts and percents
# x, y and z need to be a factor or ordered factor
# also drop the unused levels of the factors and NAs
data <- data %>%
dplyr::mutate_if(.tbl = ., not_a_factor, as.factor) %>%
dplyr::mutate_if(.tbl = ., is.factor, droplevels) %>%
dplyr::filter_all(.tbl = ., all_vars(!is.na(.))) %>%
dplyr::as_tibble(x = .)
# convert the data into percentages; group by x, y, z
# DO NOT Drop zeroes
df <-
data %>%
dplyr::group_by(.data = ., x, y, z, .drop = FALSE) %>%
dplyr::summarize(.data = ., counts = n()) %>%
dplyr::mutate(.data = ., perc = (counts / sum(counts)) * 100) %>%
dplyr::ungroup(x = .) %>%
rename(!!xlab := x, !!ylab := y, "level" := z)
return(df)
}
# Make a list of all the binary variables we want to use
# best if it's a named list variables can be bare or quoted
fff <- alist(binary1 = binary1, binary2 = binary2, binary3 = binary3)
# fff <- alist(binary1, binary2, binary3)
# fff <- alist(binary1 = "binary1", binary2 = "binary2", binary3 = "binary3")
xxx <- purrr::map_dfr(.x = fff, ~ xtabs3(df, country, sex, .x), .id = "Which_binary")
xxx
#> # A tibble: 24 x 6
#> Which_binary country sex level counts perc
#> <chr> <fct> <fct> <fct> <int> <dbl>
#> 1 binary1 germany female 0 2 66.7
#> 2 binary1 germany female 1 1 33.3
#> 3 binary1 germany male 0 1 50
#> 4 binary1 germany male 1 1 50
#> 5 binary1 USA female 0 1 25
#> 6 binary1 USA female 1 3 75
#> 7 binary1 USA male 0 1 100
#> 8 binary1 USA male 1 0 0
#> 9 binary2 germany female 0 2 66.7
#> 10 binary2 germany female 1 1 33.3
#> # … with 14 more rows
myft <- flextable(xxx, col_keys = c("Which_binary", "country", "sex", "level", "perc"))
myft <- theme_vanilla(myft)
myft <- merge_v(myft, j = c("country", "sex", "Which_binary") )
myft <- autofit(myft)
myft <- colformat_num(x = myft, j = c("perc"), digits = 1, suffix = "%")
# reprex won't let me make an html table
plot(myft)
# myft
由reprex package (v0.3.0) 于 2020 年 4 月 8 日创建