Оба из двух ответов выше выполнили свою работу, но я потратил немного времени на этот, возможно, самоизоляция стала дикой. Моей первой мыслью было использование janitor::tabyl как tabyl(df, sex, binary1, country) %>% adorn_percentages("row"), которое дает вам почти то, что вы хотите. К сожалению, он любит только одиночные переменные и не играет хорошо в цепочке purrr::map. Поэтому, используя инструменты basi c tidyverse, я написал пользовательскую функцию для создания тиббла, который будет хорошо играть с purrr, а затем, чтобы больше узнать о flextable, я использовал его, чтобы сделать вывод лучше. Обратите внимание, что ваши исходные данные не были фреймом данных, поэтому я изменил эту часть.
Преимущество моего решения IMHO в том, что оно очень расширяемо и модифицируемо.
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
Создано в 2020-04-08 пакетом представительство (v0.3.0)