Add a new row with the sum of rows in a dynamic dataframe

Question

In the shiny app below I create a datatable in which the first column is merged based on the second column values. What I want to add is one more row in the the second column under the last row for p1 (p1_5_b) and p2(p2_f)-as they are initially displayed- that will be named total and will have the sum of U and D columns for every Population(p1,p2).

library(shiny)
library(DT)

dat<-structure(list(Population = c("p1", "p1", "p1", "p1", "p1", "p1", 
                                   "p1", "p1", "p1", "p1", "p2", "p2", "p2", "p2", "p2", "p2"), 
                    var1 = c("p1_1_a", "p1_1_b", "p1_2_a", "p1_2_b", "p1_3_a", 
                             "p1_3_b", "p1_4_a", "p1_4_b", "p1_5_a", "p1_5_b", "p2_a", 
                             "p2_b", "p2_c", "p2_d", "p2_e", "p2_f"), U = c(1, 1, 0, 0, 
                                                                            1, 1, 0, 0, 1, 1, 1, 1, 0, 1, 1, 0), D = c(25, 12, 14, 11, 
                                                                                                                       3, 3, 2, 4, 5, 0, 0, 0, 0, 25, 12, 14)), row.names = c(NA, 
                                                                                                                                                                              -16L), class = c("tbl_df", "tbl", "data.frame"))
ui <- fluidPage(
  uiOutput("p"),
  uiOutput("pp"),
  DTOutput("table")
)

server <- function(input, output){
  output$p<-renderUI({
    selectInput("p1","P",choices = unique(dat$Population),multiple = T,selected =  unique(dat$Population))
  })
  output$pp<-renderUI({
    dat<-subset(dat,dat$Population%in%input$p1)
    selectInput("p2","P",choices = unique(dat$var1),multiple = T,selected =  unique(dat$var1))
  })
  df<-reactive({
    dat<-subset(dat,dat$Population%in%input$p1&dat$var1%in%input$p2)
    
  })
  output[["table"]] <- renderDT({
    dtable <- datatable(df(), rownames = FALSE, 
                        options = list(
                          rowsGroup = list(0), # merge cells of column 1
                          order = list(list(1, 'asc')),
                          pageLength=16#ascending order
                          
                        ))
    path <- "C:/Users/User/Documents/Darya/www"
    dep <- htmltools::htmlDependency(
      "RowsGroup", "2.0.0", 
      path, script = "dataTables.rowsGroup.js")
    dtable$dependencies <- c(dtable$dependencies, list(dep))
    dtable
  })
}

shinyApp(ui, server)

Answer 1

We may use adorn_totals after the subset step

library(dplyr)
library(janitor)
dat <- dat %>%
     group_by(Population) %>% 
     group_modify(~ .x %>% 
                 adorn_totals()) %>%
 ungroup  

-full code

library(shiny)
library(DT)
library(dplyr)
library(janitor)
dat<-structure(list(Population = c("p1", "p1", "p1", "p1", "p1", "p1", 
                                   "p1", "p1", "p1", "p1", "p2", "p2", "p2", "p2", "p2", "p2"), 
                    var1 = c("p1_1_a", "p1_1_b", "p1_2_a", "p1_2_b", "p1_3_a", 
                             "p1_3_b", "p1_4_a", "p1_4_b", "p1_5_a", "p1_5_b", "p2_a", 
                             "p2_b", "p2_c", "p2_d", "p2_e", "p2_f"), U = c(1, 1, 0, 0, 
                                                                            1, 1, 0, 0, 1, 1, 1, 1, 0, 1, 1, 0), D = c(25, 12, 14, 11, 
                                                                                                                       3, 3, 2, 4, 5, 0, 0, 0, 0, 25, 12, 14)), row.names = c(NA, 
                                                                                                                                                                              -16L), class = c("tbl_df", "tbl", "data.frame"))

ui <- fluidPage(
  uiOutput("p"),
  uiOutput("pp"),
  DTOutput("table")
)

server <- function(input, output){
  output$p<-renderUI({
    selectInput("p1","P",choices = unique(dat$Population),multiple = TRUE,selected =  unique(dat$Population))
  })
  output$pp<-renderUI({
    dat<-subset(dat,dat$Population%in%input$p1)
    selectInput("p2","P",choices = unique(dat$var1),multiple = TRUE,selected =  unique(dat$var1))
  })
  df<-reactive({
    dat<-subset(dat,dat$Population%in%input$p1&dat$var1%in%input$p2)
    dat <- dat %>% group_by(Population) %>% group_modify(~ .x %>% adorn_totals()) %>% ungroup  
    
  })
  output[["table"]] <- renderDT({
    dtable <- datatable(df(), rownames = FALSE, 
                        options = list(
                          rowsGroup = list(0), # merge cells of column 1
                          order = list(list(1, 'asc')),
                          pageLength=16#ascending order
                          
                        ))
    #path <- "C:/Users/User/Documents/Darya/www"
    path <- getwd()
    dep <- htmltools::htmlDependency(
      "RowsGroup", "2.0.0", 
      path, script = "dataTables.rowsGroup.js")
    dtable$dependencies <- c(dtable$dependencies, list(dep))
    dtable
  })
}

shinyApp(ui, server)

-output