r - 在 Shiny 中将总计/小计添加到数据表的底部

Question

我希望能够在下面创建的数据框的底部添加总计/小计，显示为数据表。我希望应用每个数据表过滤器来更新总计/小计。假设如果用户过滤前 10 条记录，我希望总计计算前 10 条记录的总和，或者如果用户过滤 20 条记录，我希望总计反射(reflect) 20 条记录的总和，依此类推。

我想到了一种在 R 中实现此目的的方法，即通过将新行绑定(bind)到现有数据帧来执行所需的计算。但我想知道是否有一种简单的方法可以通过 DataTables 选项来实现这一点。类似this example的东西使用页脚回调功能。

另外，请点击here和 here帮助解决类似的问题。

 #Load required packages

require(shiny)

#Create a dataframe
df <- data.frame(random=1:25)

server <- function(input,output,session){

    #Display df using DataTable and apply desired options
    output$display <- renderDataTable({df})
}

ui <- shinyUI(fluidPage(

    #Add a title
    h1('Testing TableTools'),

        mainPanel(
           #Display results
           dataTableOutput('display')
                 )      


))

shinyApp(ui = ui, server = server)

Answer 1

以下是如何对给定页面进行小计的示例。要获得总数，您可以预先计算它，然后将其粘贴到 JS 输出中？

library(shiny)
library(DT)

ui <- shinyUI(fluidPage(
  h1('Testing TableTools'),
  mainPanel(
    dataTableOutput('display')
  )      
))

Names <- c("",names(mtcars))
FooterNames <- c(rep("",4),Names[5:6],rep("",6))

server <- function(input, output, session) {

  sketch <- htmltools::withTags(table(
    tableHeader(Names),tableFooter(FooterNames)
  ))

  opts <- list(
    dom = 'Bfrtip', buttons = list('colvis','print',list(extend='collection',text='Download',buttons = list('copy','csv','excel','pdf'))),
               footerCallback = JS(
                 "function( tfoot, data, start, end, display ) {",
                 "var api = this.api(), data;",
                 "$( api.column(5).footer()).html('SubTotal:  '+",
                 "api.column(5).data().reduce( function ( a, b ) {",
                 "return a + b;",
                 "} )",
                 ");",
                 "$( api.column(4).footer()).html('SubTotal: '+",
                 "api.column(4).data().reduce( function ( a, b ) {",
                 "return a + b;",
                 "} )",
                 ");","}")
  )

  output$display <- DT::renderDataTable(container = sketch,extensions = 'Buttons',options = opts,{
    mtcars
  })
}

shinyApp(ui = ui, server = server)