r - 将包含总计和百分比的行添加到 DT 数据表

Question

我正在尝试将两行添加到我的数据表底部，一行用于总计，另一行用于计算百分比。

这是我的示例代码:

if (interactive()) {
      library(DT)
      
      fruit <- c("Apple", "Orange", "Pear", "Banana")
      num <- c(54, 25, 51, 32)
      a <- c(10, 15, 20, 25)
      b <- c(5, 7, 10, 15)
      c <- c(7, 9, 12, 17)
      
      data <- data.frame(fruit, num, a, b, c)
    
      ui <- fluidPage(
        DT::dataTableOutput(outputId = "dt_Fruit")
      )
      
      server <- function(input, output, session) {
        output$dt_Fruit <- DT::renderDataTable({
          
          df <- data %>%
            bind_rows(summarise_all(., funs(if(is.numeric(.)) sum(., na.rm = TRUE) else "Total"))) %>% # calculates Grand Total
            bind_rows(summarise_all(., funs(if(is.numeric(.)) sum(., na.rm = TRUE) else "%"))) # need help here
          
          df$num[nrow(df)] = "" # makes last row in num column blank for percent; value not needed here
          
          DT::datatable(
            df,
            rownames = FALSE,
            options = list(
              dom = 't',
              searchHighlight = TRUE,
              pageLength = 100,
              scrollX = TRUE
            )
          )
        })
      }
      shinyApp(ui, server)
    }

“总计”行按预期计算。最后一个“%”行是我需要帮助创建一个从每列中获取总计的计算的地方； a (70)、b (37) 和 c (45)，然后分别除以 num (162) 的总和，然后乘以 100 得到百分比。

所以对于最后一个百分比行:

A would be (70/162) * 100 = 43.21%  
B would be (37/162) * 100 = 22.84%  
C would be (45/162) * 100 = 27.78%

显示百分比符号也将不胜感激。
这是我想要的结果:

我已经尝试使用 df$num[nrow(df)-1] 进行一些计算，但不太确定如何将其合并到第二行 bind_rows 中。谢谢!

Answer 1

这可以这样实现:

1. 制作总计行

   total <- data %>% 
         summarise(across(where(is.numeric), sum)) %>% 
         mutate(fruit = "Total")
   

2. 制作百分比行(格式为 %，例如 scales::percent)

   total_pct <- total %>% 
      mutate(across(where(is.numeric), ~ .x / num),
             across(where(is.numeric), ~ scales::percent(.x, accuracy = .01)),
             fruit = "%")
   

3. 将总计绑定(bind)到数据表。由于 total_row 中的列是字符类型，我们首先必须将 data 和 total 转换为字符，我通过 lapply 和 mutate_all

   df <- lapply(list(data, total, total_pct), mutate_all, as.character) %>% 
         bind_rows()
   

完整的可重现代码:

library(dplyr)
library(shiny)
library(DT)

fruit <- c("Apple", "Orange", "Pear", "Banana")
num <- c(54, 25, 51, 32)
a <- c(10, 15, 20, 25)
b <- c(5, 7, 10, 15)
c <- c(7, 9, 12, 17)

data <- data.frame(fruit, num, a, b, c)

ui <- fluidPage(
  DT::dataTableOutput(outputId = "dt_Fruit")
)

server <- function(input, output, session) {
  output$dt_Fruit <- DT::renderDataTable({
    
    total <- data %>% 
      summarise(across(where(is.numeric), sum)) %>% 
      mutate(fruit = "Total")
    
    total_pct <- total %>% 
      mutate(across(where(is.numeric), ~ .x / num),
             across(where(is.numeric), ~ scales::percent(.x, accuracy = .01)),
             fruit = "%")
    
    df <- lapply(list(data, total, total_pct), mutate_all, as.character) %>% 
      bind_rows()
    
    df$num[nrow(df)] = "" # makes last row in num column blank for percent; value not needed here
    
    DT::datatable(
      df,
      rownames = FALSE,
      options = list(
        dom = 't',
        searchHighlight = TRUE,
        pageLength = 100,
        scrollX = TRUE
      )
    )
  })
}
shinyApp(ui, server)