r - 更新数据表头而不刷新整个应用程序(R,Shiny) dataTableProxy()
问题描述
我正在尝试制作一个闪亮的应用程序。
(1) 我想更新数据表而不刷新整个应用程序。>>> 我用isolate({})
and解决它dataTableProxy()
。
(2)我想在不刷新整个应用程序的情况下更新表头(列名),例如(如果用户在selectInput中选择2020。表中的新列名应该更新为年份:2020而不刷新整个应用程序)。
我怎样才能做到这一点?
library(DT)
library(data.table)
library(dplyr)
library(shiny)
ui <- fluidPage(
selectInput(inputId = 'choice', label = 'choice', choices = c('A', 'B'), selected = 'A'),
selectInput(inputId = 'country', label = 'country', choices = c('UK', 'USA', 'CANADA'), selected = 'UK'),
selectInput(inputId = 'year', label = 'year', choices = c(2020, 2021), selected = 2020),
uiOutput(outputId = "table")
)
server <- function(input, output, session) {
data_a <- data.frame(year = c(rep(2020,6), rep(2021,6)),
country = c('UK', 'UK', 'USA', 'USA', 'CANADA','CANADA'),
type_a = c('AA', 'BB'),
num = sample(10:22, 12))
dt_a <- reactive({
if (input$choice == 'A'){
return(data_a %>% filter(year == input$year & country == input$country))
}
})
output$rtable_a <- DT::renderDataTable({
if (input$choice == 'A'){
DT <- DT::datatable(isolate({dt_a()}),
rownames = FALSE,
options = list(processing = FALSE),
colnames = c('YEAR', 'COUNTRY', paste('year_a:', input$year), 'NUMBER')
)
return(DT)
}
})
proxy_a <- DT::dataTableProxy('rtable_a')
observe({
DT::replaceData(proxy_a, dt_a(), rownames = FALSE)
})
output$table <- renderUI({
if (input$choice == 'A'){
return(DT::dataTableOutput("rtable_a", width = '75%'))
}
})
}
shinyApp(ui, server)
解决方案
这是使用 JavaScript 库jQuery contextMenu的解决方案。右键单击列标题并选择年份。
library(shiny)
library(DT)
callback <- c(
"var choices = {1: '2020', 2: '2021'};",
"var id = $(table.table().node()).closest('.datatables').attr('id');",
"$.contextMenu({",
" selector: '#' + id + ' th:eq(3)',",
" trigger: 'right',",
" autoHide: true,",
" items: {",
" select: {",
" name: 'Select year:',",
" type: 'select',",
" options: choices,",
" selected: '1'",
" }",
" },",
" events: {",
" hide: function(opt){",
" var $this = this;",
" var i = $.contextMenu.getInputValues(opt, $this.data()).select;",
" var year = choices[i];",
" Shiny.setInputValue('year', year);",
" var text = 'year_a: ' + year;",
" var $th = opt.$trigger;",
" $th.text(text);",
" }",
" }",
"});"
)
data_a <- data.frame(
"YEAR" = c(rep(2020,6), rep(2021,6)),
"COUNTRY" = c('UK', 'UK', 'USA', 'USA', 'CANADA','CANADA'),
"year_a: 2020" = c('AA', 'BB'),
"NUMBER" = sample(10:22, 12),
check.names = FALSE
)
ui <- fluidPage(
tags$head(
tags$link(rel = "stylesheet", href = "https://cdnjs.cloudflare.com/ajax/libs/jquery-contextmenu/2.9.2/jquery.contextMenu.min.css"),
tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/jquery-contextmenu/2.9.2/jquery.contextMenu.min.js")
),
DTOutput("dtable")
)
server <- function(input, output){
output[["dtable"]] <- renderDT({
datatable(data_a, callback = JS(callback))
}, server = FALSE)
observe({ # selected year
print(input[["year"]])
})
}
shinyApp(ui, server)
编辑
带过滤:
library(shiny)
library(DT)
callback <- c(
"Shiny.setInputValue('year', '2020');",
"var choices = {1: '2020', 2: '2021'};",
"var id = $(table.table().node()).closest('.datatables').attr('id');",
"$.contextMenu({",
" selector: '#' + id + ' th:eq(3)',",
" trigger: 'right',",
" autoHide: true,",
" items: {",
" select: {",
" name: 'Select year:',",
" type: 'select',",
" options: choices,",
" selected: '1'",
" }",
" },",
" events: {",
" hide: function(opt){",
" var $this = this;",
" var i = $.contextMenu.getInputValues(opt, $this.data()).select;",
" var year = choices[i];",
" Shiny.setInputValue('year', year);",
" var text = 'year_a: ' + year;",
" var $th = opt.$trigger;",
" $th.text(text);",
" }",
" }",
"});"
)
data_a <- data.frame(
"YEAR" = c(rep(2020,6), rep(2021,6)),
"COUNTRY" = c('UK', 'UK', 'USA', 'USA', 'CANADA','CANADA'),
"year_a: 2020" = c('AA', 'BB'),
"NUMBER" = sample(10:22, 12),
check.names = FALSE
)
ui <- fluidPage(
tags$head(
tags$link(rel = "stylesheet", href = "https://cdnjs.cloudflare.com/ajax/libs/jquery-contextmenu/2.9.2/jquery.contextMenu.min.css"),
tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/jquery-contextmenu/2.9.2/jquery.contextMenu.min.js")
),
DTOutput("dtable")
)
server <- function(input, output){
output[["dtable"]] <- renderDT({
datatable(data_a, callback = JS(callback))
}, server = TRUE)
proxy <- dataTableProxy("dtable")
observeEvent(input[["year"]], {
replaceData(proxy, subset(data_a, YEAR == input[["year"]]))
})
}
shinyApp(ui, server)
推荐阅读
- angular - 我应该如何管理默认复选框状态
- python-2.7 - 当我的报告超过一页时如何在每一页中显示我的页脚
- python - 如何计算不同熊猫列中两个日期之间的年数
- chm - 链接到 HelpnDoc 中的特定主题使用 Visual C++ HtmlHelp 编译 CHM
- javascript - Angular5-Ngx-pagination:检查第一页或最后一页
- clojure - 最好的实时通话 quil 功能是什么?
- node.js - dialogflow webhook 实现代码失败
- sql - SQL:如何将值汇总到 ssms 中的类别中
- angular - Angular 4 和 MVC 数据绑定错误
- javascript - 在 redux 中创建选择器不起作用