Add a row with totals and percentages to a DT datatable

Question

I'm trying to add two rows to the bottom of my datatable, one for the Grand Total, and one below that that calculates a percent.

Here's my example code:

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)
    }

The "Total" line calculates as expected. The last "%" row is where I need help creating a calculation that takes the Total from each column; a (70), b (37) and c (45), and divides each of them by the Total of num (162), then multiplying that by 100 to give a percent.

So for the last percent row:

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

Showing the percent symbol would also be appreciated.
Here is my desired result:

I've tried some calculations using df$num[nrow(df)-1] but not quite sure how to incorporate that into the second bind_rows line. Thanks!

Answer 1

This could be achieved like so:

1. Make totals row

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

2. Make percentages row (format as % via e.g. scales::percent)

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

3. Bind totals to the data table. As the columns in total_row are of type character we first have to convert data and total to character as well which I do via lapply and mutate_all

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

Full reproducible code:

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)