Таблица с несколькими категориальными переменными с частотами

Question

library("tidyverse")
library("papaja")

df <- structure(list(investment_type = structure(c(3L, 3L, 3L, 3L, 
3L, 3L, 3L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 1L, 3L, 3L, 3L, 
3L), .Label = c("angel", "pre_seed", "seed"), class = "factor"), 
    gender_d = c(1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 
    1, 1, 1, 1, 0, 1), state_code_org = structure(c(3L, 22L, 
    3L, 15L, 3L, 4L, 3L, 3L, 22L, 3L, 29L, 25L, 8L, 29L, 10L, 
    6L, 22L, 4L, 17L, 23L, 17L), .Label = c("AL", "AR", "CA", 
    "CO", "CT", "DC", "DE", "FL", "GA", "IL", "KS", "LA", "MA", 
    "MD", "MN", "MO", "NC", "NE", "NH", "NJ", "NV", "NY", "OH", 
    "OR", "PA", "RI", "SC", "TN", "TX", "UT", "VA", "VT", "WA", 
    "WI", "WY"), class = "factor"), first_time_founder_d = c(0, 
    1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, NA, 1, 0, 0, 1, 
    0)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, 
-21L))

df <- df %>%
  select(investment_type,
         state_code_org,
         gender_d,
         first_time_founder_d) %>%
  mutate_at(c("gender_d", "first_time_founder_d"), list(~ factor(.))) %>%
  mutate(gender_d=factor(ifelse(gender_d==1, "Male", "Female"))) %>%
  mutate(first_time_founder_d=factor(ifelse(first_time_founder_d==1, "Yes", "No"))) %>%
  mutate(investment_type=factor(ifelse(investment_type=="angel", "Angel", ifelse(investment_type=="pre_seed", "Pre-Seed", "Seed")))) %>%
  drop_na() %>%
  summary() %>%
  as.data.frame()

# Clean up columns
df <- df %>%
  select(-Var1) %>%
  rename(Variable=Var2, N=Freq) %>%
  mutate(Variable=factor(ifelse(Variable=="investment_type", "Investment Type", ifelse(Variable=="state_code_org", "State", ifelse(str_detect(Variable, "gender_d"), "Gender", "First-Time Founder"))))) %>%
  drop_na()

# break N into level and N
df <- df %>%
  separate(col = N, into = c("Level", "N"), sep = ":")

# Remove white space in values
df <- df %>% 
  mutate(
    Variable=trimws(Variable)) %>%
  mutate(
    Level=trimws(Level)) %>%
  mutate(
    N=trimws(N))

# Convert N to integer
df <- df %>% 
  mutate(N=as.integer(N))

df <- df %>% 
  group_by(Variable) %>% 
  arrange(Variable, desc(N))

apa_table(
  df,
  # stub_indents = list("1", "2"),
  caption = "Summary of categorical variables.",
  note = "Missing data is not shown.")

Вот что я получаю сейчас.

Я открыт для использования любых пакетов - это случается с использованием папайи. Но он должен работать в rmarkdown с выводом PDF и соответствовать стилю APA.

Я хотел бы, чтобы таблица свернула значения переменных, чтобы они не повторялись более одного раза, а также переместила состояние (другое) в низ государственной группировки. Примерно так (другой набор данных) в качестве примера:

Answer 1

Вы можете попробовать пакет gt (еще не в CRAN).

# devtools::install_github("rstudio/gt")
library(gt)
df %>%
  mutate(`%` = scales::percent(N / sum(N), 1)) %>%
  gt() %>%
  tab_header(
    title = "Summary of categorical variables."
  ) %>%    
  tab_source_note(
    source_note = md("*Missing data is not shown.*")
  )

Это HTML исполнение. Он использует группы dplyr для определения группировки строк.

В репо и https://gt.rstudio.com оба говорят, что он поддерживает вывод в HTML, причем LaTeX и RTF запланированы для будущее, но это несколько работает.

df %>%
  mutate(`%` = scales::percent(N / sum(N), 1)) %>%
  gt() %>%
  # tab_header(
  #   title = "Summary of categorical variables.", subtitle = ""
  # ) %>%    
  tab_source_note(
    source_note = md("*Missing data is not shown.*")
  ) %>%
  as_latex()

Есть ошибка с tab_header и выводом латекса (https://github.com/rstudio/gt/issues/463), и похоже, что tab_source_note может быть немного косо.

Я немного переставил вещи и смог это получить, хотя уверен, что это не совсем то ты идешь на. (Это говорит о том, что все, что не является пробелом в субтитре, позволяет tab_header работать, но " " - любое количество пробелов - не работает.)

df %>%
  mutate(`%` = scales::percent(N / sum(N), 1)) %>%
  gt() %>%
  tab_header(
    title = "Summary of categorical variables.",
    subtitle = md("*Missing data is not shown.*")
  ) %>%    
  as_latex()

Answer 2

Вот еще один подход, использующий apa_table().

Сначала более простой способ суммировать ваши данные:

library("dplyr")
library("tidyr")

df <- structure(list(investment_type = structure(c(3L, 3L, 3L, 3L, 
                                             3L, 3L, 3L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 1L, 3L, 3L, 3L, 
                                             3L), .Label = c("angel", "pre_seed", "seed"), class = "factor"), 
               gender_d = c(1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 
                            1, 1, 1, 1, 0, 1), state_code_org = structure(c(3L, 22L, 
                                                                            3L, 15L, 3L, 4L, 3L, 3L, 22L, 3L, 29L, 25L, 8L, 29L, 10L, 
                                                                            6L, 22L, 4L, 17L, 23L, 17L), .Label = c("AL", "AR", "CA", 
                                                                                                                    "CO", "CT", "DC", "DE", "FL", "GA", "IL", "KS", "LA", "MA", 
                                                                                                                    "MD", "MN", "MO", "NC", "NE", "NH", "NJ", "NV", "NY", "OH", 
                                                                                                                    "OR", "PA", "RI", "SC", "TN", "TX", "UT", "VA", "VT", "WA", 
                                                                                                                    "WI", "WY"), class = "factor"), first_time_founder_d = c(0, 
                                                                                                                                                                             1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, NA, 1, 0, 0, 1, 
                                                                                                                                                                             0)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, 
                                                                                                                                                                                                                                          -21L))

factor_level_count <- df %>% 
  mutate(
    gender_d = factor(gender_d, levels = c(0, 1), labels = c("Female", "Male"))
    , first_time_founder_d = factor(first_time_founder_d, levels = c(0, 1), labels = c("No", "Yes"))
    , investment_type = factor(investment_type, levels = c("angel", "pre_seed", "seed"), labels = c("Angel", "Pre-Seed", "Seed"))
  ) %>%
  na.exclude %>% 
  pivot_longer(cols = everything()) %>% 
  group_by(name, value) %>% 
  count() %>%
  ungroup() %>% 
  mutate(
    name = factor(name , levels = c("first_time_founder_d", "gender_d", "investment_type", "state_code_org"), labels = c("Firt-Time Founder", "Gender", "Investement Type", "State"))
  ) %>% 
  group_by(name) %>% 
  mutate(percent = printnum(n / sum(n) * 100, digits = 1)) %>% 
  rename(Variable = value, N = n, "%" = percent)

Теперь вы можете разбить data.frame и объединить их в именованный список чтобы получить отступы.

factor_level_count_list <- split(factor_level_count, f = factor_level_count$name, drop = TRUE) %>% 
  lapply(function(x) x[, -1]) # Removes split-column

library("papaja")

apa_table(
  factor_level_count_list
  , align = "llr"             # Right-align last column
  , caption = "Summary of categorical variables."
  , note = "Missing data is not shown."
  , merge_method = "indent"   # Table style to use for merging list elements
  , midrules = c(3, 6, 9)
)

Answer 3

Я думаю, что здесь было бы простое решение:

df$Variable[duplicated(df$Variable)] <- ""     # remove duplicated labels
df <- df[c(1:7, 9:13, 8), ]                    # move "(other)" to last row

apa_table(
  df,
  align = "llr",                               # right-align last column
  caption = "Summary of categorical variables.",
  note = "Missing data is not shown.")

, которое выглядит как: