te time
te time

Reputation: 495

Add dynamic subtotals to Shiny DataTable

I am trying to add a summary row to a filterable table that shows the totals/subtotals and other summary functions. In my example below I would like totals for investment, Value, and Profit and average ROI for any combination of the the filters Asset and Symbol.

Here are pictures to show my desired result:

All Assets:

enter image description here

Stock Selected:

enter image description here

Bond Selected:

enter image description here

I am also trying to format my columns but wherever I add this formatting code in theif pipeline it does not work.

formatCurrency( ~investment+Value+Profit ) %>%
               formatStyle( c('ROI','Profit'),color = styleInterval(c(0), 
               c('red', 'green')),fontWeight = 'bold') %>%
               formatPercentage(~ROI,digits=1)

R Shiny code:

    library(tidyverse)
    library(DT)
    library(formattable)
    library(shiny)
    
    
    
    assetTable <- structure(list(symbol = c("A", "B", "C", "D", "E", "F", "G", 
                                            "H", "I"), Asset = c("Stock", "Stock", "Bond", "Bond", "Stock", 
                                            "Bond", "Stock", "Bond", "Stock"), investment = c(154, 362, 181, 
                                             851, 510, 539, 527, 369, 234), Value = c(330, 763, 911, 535, 
                                             220, 450, 576, 903, 905), Profit = c(176, 401, 730, -316, -290, 
                                             -89, 49, 534, 671), ROI = c(1.14285714285714, 1.10773480662983, 
                                             4.03314917127072, -0.371327849588719, -0.568627450980392, 
                                             -0.165120593692022,0.0929791271347249, 1.44715447154472, 
                                             2.86752136752137)), row.names = c(NA,-9L),
                                             class = c("tbl_df", "tbl", "data.frame"))
    
    
    ui <- fluidPage(
        titlePanel("Table with column summary"),
        
        # Create a new Row in the UI for selectInputs
        fluidRow(
            column(4,
                   selectInput("Asset",
                               "Asset Type:",
                               c("All",
                                 unique(as.character(assetTable$Asset))))
            )
            ,
            column(4,
                   selectInput("symbol",
                               "Symbol",
                               c("All",
                                 unique(as.character(assetTable$symbol))))
            )
        ),
        
        DT::dataTableOutput("table")
    
    )
    
    
    server <- function(input, output) {
        
        # Filter data based on selections
        output$table <- DT::renderDataTable(DT::datatable({
            data <-assetTable 
            
            
            
            if (input$Asset!= "All") {
                data <- data[data$Asset == input$Asset,] 
            }
            
            if (input$symbol != "All") {
                data <- data[data$symbol == input$symbol,]
            }
            data
        }))
        
    }

# Run the application 
shinyApp(ui = ui, server = server)

Upvotes: 1

Views: 1060

Answers (1)

akrun
akrun

Reputation: 887951

In order to get the sum and mean, we can use adorn_totals from janitor

library(dplyr)
library(janitor)

Also, as we are redoing the same summarisation, it could be made into a function

f1 <- function(dat, colnm, colval) {
  
  dat %>%
    # // filter the rows based on the input string  from colval
    filter({{colnm}} == colval) %>%
    # // create a mean column for ROI
    mutate(ROImean = mean(ROI)) %>%
    # // make use of adorn_totals for the selected columns
    adorn_totals(where = "row", fill = '-', 
                 na.rm = TRUE, name = 'Total', c('investment', 'Value', 
                                                 'Profit', 'ROI', 'ROImean')) %>%
    # // replace the ROI last row (n() => last row index) 
    # // with first element of ROImean
    mutate(ROI = replace(ROI, n(), first(ROImean))) %>%
    # // remove the temporary ROImean column
    select(-ROImean) %>%
    # // change the format of specific columns
    mutate(across(c(investment, Value, Profit), 
           ~ as.character(formattable::currency(., symbol = '$', 
         digits = 2L, format = "f", big.mark = ","))), 
       ROI = as.character(formattable::percent(ROI, digits = 2)))
}

Now, the call becomes much more compact within server

server <- function(input, output) {
  
  # Filter data based on selections
  output$table <- DT::renderDataTable(DT::datatable({
    data <- assetTable 
    
    
    
    if (input$Asset!= "All") {
      data <- f1(data, Asset, input$Asset)
    }
    
    if (input$symbol != "All") {
      data <- f1(data, symbol, input$symbol)
    }
    data
  }))
  
}

-output

enter image description here

Upvotes: 5

Related Questions