在DT数据表中添加包含总计和百分比的行

问题描述

我正在尝试在数据表的底部添加两行,其中一列用于总计,而下一行用于计算百分比。

这是我的示例代码

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(.,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),然后将它们除以总数(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%

也可以显示百分比符号。
这是我想要的结果:

enter image description here

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

解决方法

可以这样实现:

  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. 绑定总计到数据表。由于total_row中的列是字符类型,因此我们首先必须将datatotal转换为字符,这也是我通过lapplymutate_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),fruit = "%")
    
    df <- lapply(list(data,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)