DT dataTable中的列总数有光泽

时间:2018-03-06 16:35:34

标签: r shiny datatables-1.10 dt

我正在尝试使用DT :: datatable计算我的闪亮应用中列的。总计是指表中所有元素的总和,而不仅仅是当前分页中显示的内容。在example之后,以下代码应该有效(但它不会):

jsCode <- "function(row, data, start, end, display) {

                  var api = this.api(), data;

                  total = api.column(1, {page: 'all'}).data().reduce( function(a, b) { return a + b}, 0); 

                  $( api.column(1).footer() ).html('Total: ' + total);
                  }"

我从中得到的只是当前分页中元素的总和。完整代码如下:

library(shiny)
library(DT)

set.seed(2282018)
company <- data.frame(Company = letters[1:30], Units = round(runif(30, 
                                                             1000, 10e6), 0), 
                      Price = scales::dollar(runif(30, 200, 1230)), stringsAsFactors = F)

jsCode <- "function(row, data, start, end, display) {

                  var api = this.api(), data;

                  total = api.column(1, {page: 'all'}).data().reduce( function(a, b) { return a + b}, 0); 

                  $( api.column(1).footer() ).html('Total: ' + total);
                  }"

# UI ---- 
ui <- function(){

  fluidPage(

    sidebarLayout(

      sidebarPanel(numericInput("nums", label = "Num Input", value = 1, min = 1, max = 10)),

      mainPanel(dataTableOutput("mytable"))

    )

  )

}

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

  cont <- htmltools::withTags(table(
    tableHeader(names(company)),tableFooter(names(company))
  ))

  output$mytable <- DT::renderDataTable(  {

    DT::datatable(company,
                  container = cont,
                  caption = tags$caption("Example"), 
                  filter = "none", 
                  rownames = F,
                  options = list(autoWidth = T, 
                                 pageLength = 10, 
                                 scrollCollapse = T,
                                 dom = 'lftp', 
                                 footerCallback = JS(jsCode))
                  )
  }
  )
}

runApp(list(ui = ui, server = server))

谢谢

1 个答案:

答案 0 :(得分:3)

也许你可以编写一个解决方法:如下所示:

library(shiny)
library(DT)

set.seed(2282018)
company <- data.frame(Company = letters[1:30], Units = round(runif(30,  1000, 10e6), 0), Price = scales::dollar(runif(30, 200, 1230)), stringsAsFactors = F)
jsCode <- "function(row, data, start, end, display) {var api = this.api(), data;$( api.column(1).footer() ).html('Total: ' + MYTOTAL);}"

# Workaround
getTotal <- function(data,index){

  if(index < 1 || index > ncol(data)){
    return("")
  }
  col <- data[,index]
  col <- gsub("[$]","",col)
  col <- gsub("[£]","",col)
  col <- gsub("[,]","",col)
  col <- suppressWarnings(as.numeric(col))
  if(all(is.na(col))){
    return("")
  }
  sum(col)
}


ui <- function(){
  fluidPage(
    sidebarLayout(
      sidebarPanel(numericInput("nums", label = "Num Input", value = 1, min = 1, max = 10)),
      mainPanel(dataTableOutput("mytable"))
    )
  )
}

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

  Total <- reactive({
    getTotal(company,2)
  })

  cont <- htmltools::withTags(table(
    tableHeader(names(company)),tableFooter(names(company))
  ))

  output$mytable <- DT::renderDataTable(  {
    jsCode <- sub("MYTOTAL",Total(),jsCode)
    DT::datatable(company,
                  container = cont,
                  caption = tags$caption("Example"), 
                  filter = "none", 
                  rownames = F,
                  options = list(autoWidth = T, 
                                 pageLength = 10, 
                                 scrollCollapse = T,
                                 dom = 'lftp', 
                                 footerCallback = JS(jsCode))
    )
  }
  )
}

runApp(list(ui = ui, server = server))

enter image description here