将动态小计添加到 Shiny DataTable

Question

我正在尝试将汇总行添加到显示总计/小计和其他汇总函数的可过滤表中。在我的例子下面我想对于总量investment，Value以及Profit平均 ROI 的过滤器的任意组合Asset和Symbol。

以下是显示我想要的结果的图片：

所有资产：

所选股票：

债券选择：

我也在尝试格式化我的列，但是在if管道中添加此格式化代码的任何地方都不起作用。

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

R闪亮代码：

    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)

Answer 1

为了得到sumand mean，我们可以使用adorn_totalsfromjanitor

library(dplyr)
library(janitor)

另外，当我们重新做同样的总结时，它可以变成一个函数

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

现在，调用在服务器中变得更加紧凑

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

-输出