在R中格式化一个ft表

Question

我有以下我在R中创建的3路表。

with(dataset, ftable(xtabs(count ~ dos + sex + edu)))

输出看起来像

 edu                                 high     low  medium unknown
dos                  sex                                           
five-to-ten-years   female          247776   44916  127133   23793
                    male            225403   37858  147821   20383
five-years-or-less  female          304851   58018  182152   33649
                    male            253977   55720  193621   28972
more-than-ten-years female          709303  452605  539403  165675
                    male            629162  309193  689299  121336
native-born         female         1988476 1456792 2094297  502153
                    male           1411509 1197395 2790522  395953
unknown             female           57974   75480   73204  593141
                    male             40176   57786   93108  605542

我想重新命名变量并格式化表格，以便将其包含在报告中。我知道我可以使用dnn来重命名变量，但是有什么其他的建议来重命名变量吗？还有如何格式化表格（类似于使用kable）？

Answer 1

你可以使用下面的函数将输出转换为文本矩阵，之后你就可以用kable来改变你的风格。

ftab_to_matrix <- function(ft)
{
   row_vars      <- attr(ft, "row.vars")

   for(i in seq_along(row_vars)){
     row_vars[[i]] <- c(names(row_vars[i]), row_vars[[i]])}

   rowvar_widths <- sapply(row_vars, function(x) max(nchar(x))) + 1   
   col_vars      <- attr(ft, "col.vars")
   rowvar_widths <- c(1, cumsum(c(rowvar_widths, max(nchar(names(col_vars))))))
   ft_text       <- capture.output(print(ft))
   row_cols      <- sapply(seq_along(rowvar_widths)[-1], function(x)
                           substr(ft_text, rowvar_widths[x - 1], rowvar_widths[x]))
   ft_text       <- substr(ft_text, rowvar_widths[length(rowvar_widths)] + 2, 100)
   ft_breaks     <- c(1, cumsum(lapply(strsplit(ft_text[length(ft_text)], "\\d "), 
                                       function(x) nchar(x) + 2)[[1]]))
   col_cols      <- sapply(seq_along(ft_breaks)[-1], function(x)
                           substr(ft_text, ft_breaks[x - 1], ft_breaks[x]))
   trimws(cbind(row_cols, col_cols))
}

所以，举例来说，用我上一个问题中的数据为例，你可以这样做：

my_tab <- with(`3waydata`, ftable(xtabs(count ~ duration + sex + education)))
as_image(kable_styling(kable(ftab_to_df(my_tab))), file = "kable.png")

Answer 2

如果你在问第一个问题的时候就给出完整的情况，可能会更容易... ... 你可以使用 gt 为报表制作花哨的表格。 这是一个编辑过的版本，更全面地展示了一些功能。

library(dplyr)
library(gt)


way3data <- data %>%
   group_by(duration, education, sex) %>%
   summarise(count = sum(number)) %>% 
   ungroup

# Reorder with select and Titlecase with stringr
longer <- tidyr::pivot_wider(way3data, 
                             values_from = count, 
                             names_from = "education") %>%
  select(duration, sex, high, medium, low, unknown) %>%
  rename_with(stringr::str_to_title)

# Demonstrating some of the features of gt
# obviously could have done some of this 
# to the original dataframe

myresults <- longer %>% 
  group_by(Duration) %>% 
  gt(rowname_col = "Sex") %>% 
  row_group_order(
    groups = c("native-born",
               "more-than-ten-years", 
               "five-to-ten-years", 
               "five-years-or-less",
               "unknown")
            ) %>%
  tab_spanner(label = "Education", 
              columns = matches("High|Low|Medium|Unknown")) %>%
  tab_stubhead(label = "Duration or something") %>%
  tab_style(
    style = cell_text(style = "oblique", weight = "bold"),
    locations = cells_row_groups())  %>%
  tab_style(
    style = cell_text(align = "right", style = "italic", weight = "bold"),
    locations = cells_column_labels(
      columns = vars(High, Low, Medium, Unknown)
    ))  %>%
  tab_style(
    style = cell_text(align = "right", weight = "bold"),
    locations = cells_stub())  %>%
  tab_header(
    title = "Fancy table of counts with Duration, Education and Gender") %>%
  tab_source_note(md("More information is available at https://stackoverflow.com/questions/62284264."))

# myresults

# Can save in other formats including .rtf
myresults %>%
  gtsave(
    "tab_1.png", expand = 10
  )

你可以阅读所有的格式选择 此处

数据由Allan提供

set.seed(69)
data <- data.frame(education = sample(c("high","low","medium","unknown"), 600, T),
                   sex       = rep(c("Male", "Female"), 300),
                   duration  = sample(c("unknown", "native-born",
                                        "five-years-or-less", "five-to-ten-years",
                                        "more-than-ten-years"), 600, T),
                   number    = rpois(600, 10))