Блог

Я хочу добавить строки в определенное место для 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)
  

Не уверен, что есть простой метод, экспортируемый с помощью expss , но мы можем использовать expss::add_rows() с помощью простой пользовательской функции для разделения таблицы для достижения этой цели.

 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 |
  

Решение, основанное на коде @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"))