从 expss R 包中在 etable 中添加行

Question

我想在特定位置添加行到 expss 输出 etable。我用一些蛮力方法做到了这一点，该方法总是在 etable 的开头添加行。在特定位置添加行的任何方法。

library(tidyverse)
library(expss)

test1 <-
    mtcars %>% 
    tab_cells(cyl) %>% 
    tab_cols(vs) %>% 
    tab_stat_cpct() %>% 
    tab_pivot()

test1 %>% 
  tibble() %>% 
  tibble::add_row(.data = tibble("", test1[2, -1]/test1[1, -1]*100) %>% 
            set_names(names(test1))
          , .before = 3)

Answer 1

不确定是否有使用 expss 导出的简单方法，但我们可以使用 expss::add_rows() 和一个简单的自定义函数来拆分 table 来完成此操作。

insert_row <- function(tbl, where, ...) {
  args <- c(...)
  tbl1 <- tbl[1:where,]
  tbl2 <- tbl[(where+1):nrow(tbl),]
  tbl1 %>%
    add_rows(args) %>%
    add_rows(tbl2)
}

insert_row(test1, 2, c("cyl|4", 300, 40))

 |     |              |               vs |                  |
 |     |              |                0 |                1 |
 | --- | ------------ | ---------------- | ---------------- |
 | cyl |            4 | 5.55555555555556 | 71.4285714285714 |
 |     |            6 | 16.6666666666667 | 28.5714285714286 |
 |     |            4 |              300 |               40 |
 |     |            8 | 77.7777777777778 |                  |
 |     | #Total cases |               18 |               14 |

Answer 2

基于@caldwellst 代码但具有自动比率计算的解决方案：

insert_ratio <- function(tbl, where) {
    if(is.character(where)) {
        # if where is character we search it in the rowlabels
        where = grep(where, tbl[[1]], fixed = TRUE)[1]
    }
    isTRUE(where>1) || stop("'where' should be greater than 1 for ratio calculation.")
    isTRUE(where<=NROW(tbl)) || stop("'where' should be less or equal than number of rows in the table.")
    tbl1 <- tbl[1:where,]
    to_insert = c(row_labels = tbl[[1]][where], tbl[where, -1]/tbl[where - 1, -1]*100)
    tbl2 <- tbl[(where+1):nrow(tbl),]
    tbl1 %>%
        add_rows(to_insert) %>%
        add_rows(tbl2)
}

insert_ratio(test1, 2)
 # |     |              |    vs |      |
 # |     |              |     0 |    1 |
 # | --- | ------------ | ----- | ---- |
 # | cyl |            4 |   5.6 | 71.4 |
 # |     |            6 |  16.7 | 28.6 |
 # |     |              | 300.0 | 40.0 |
 # |     |            8 |  77.8 |      |
 # |     | #Total cases |  18.0 | 14.0 |

insert_ratio(test1, "cyl|6")
 # the same result

更新比率计算移至单独的函数：

ratio = function(tbl, where, label = NULL){
    if(is.character(where)) {
        # if where is character we search it in the rowlabels
        where = grep(where, tbl[[1]], fixed = TRUE)[1]
    }
    isTRUE(where>1) || stop("'where' should be greater than 1 for ratio calculation.")
    isTRUE(where<=NROW(tbl)) || stop("'where' should be less or equal than number of rows in the table.")
    
    if(is.null(label)) label = tbl[[1]][where]
    c(row_labels = label, tbl[where, -1]/tbl[where - 1, -1]*100)
}

insert_row = function(tbl, where, row) {
    if(is.character(where)) {
        # if where is character we search it in the rowlabels
        where = grep(where, tbl[[1]], fixed = TRUE)[1]
    }
    isTRUE(where<=NROW(tbl)) || stop("'where' should be less or equal than number of rows in the table.")
    first_part = seq_len(where)
    tbl1 <- tbl[first_part,]
    
    tbl2 <- tbl[-first_part,]
    tbl1 %>%
        add_rows(row) %>%
        add_rows(tbl2)
}

insert_row(test1, 2, ratio(test1, 2))
insert_row(test1, "cyl|6", ratio(test1, "cyl|6"))

从 expss R 包中在 etable 中添加行

Add row in etable from expss R package

r

tidyverse

expss