使用下拉选择在SHILINY中编辑数据表(适用于DT v0.19) [英] Edit datatable in shiny with dropdown selection (for DT v0.19)
本文介绍了使用下拉选择在SHILINY中编辑数据表(适用于DT v0.19)的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我根据Stephane Laurent对以下堆栈溢出问题的解决方案编写了以下代码：
Edit datatable in Shiny with dropdown selection for factor variables
我添加了代码，以便使用editData更新表并能够保存/导出更新。
以下代码适用于DT v0.18，但对于DT v0.19，我发现id_cell_edit似乎没有触发。我不确定这是与回调有关，还是与给定DT0.19升级到jQuery3.0的jquery.contextMenu有关。如果人们对如何解决此问题有任何见解，我将不胜感激。
以下是我在使用v0.18时观察到的行为的描述。当我选择Usage列并将第一行的值从默认的"sel"更新为"id"时，DT表中的值会更改。我还看到它会更新Tibble的视图，因此下载的CSV文件中的数据也会更新。如果我前进到下一页以查看第11个项目，然后返回到第一页，我可以看到我更新的记录仍然显示为"id"。
以下是我在使用v0.19时观察到的行为的描述。当我选择Usage列并将第一行的值从默认的"sel"更新为"id"时，DT表中的值会更改。它不会更新Tibble的视图，因此下载的CSV文件中的数据不会更新。如果我前进到下一页以查看第11个项目，然后返回到第一页，我所做的更新将被清除。
请注意，我还使用reactlog运行了反应图。我按照相同的步骤将第一行的Usage列更新为"；id"；。我注意到的第一个区别是，步骤5中的reactiveValues#$dt在我使用版本v0.18时给我的列表是7，当我使用版本v0.19时给出的列表是8。在步骤16，对于v0.18，输入$DT_CELL_EDIT无效，然后数据无效，输出$TABLE无效。但是，在步骤16使用v0.19时，输出$DT无效，然后输出$TABLE INVALIATES。换言之，使用版本0.19时，输入$DT_CELL_EDIT和数据不会失效。library(shiny)
library(DT)
library(dplyr)
cars_df <- mtcars
cars_meta <- dplyr::tibble(variables = names(cars_df), data_class = sapply(cars_df, class), usage = "sel")
cars_meta$data_class <- factor(cars_meta$data_class, c("numeric", "character", "factor", "logical"))
cars_meta$usage <- factor(cars_meta$usage, c("id", "meta", "demo", "sel", "text"))
callback <- c(
"var id = $(table.table().node()).closest('.datatables').attr('id');",
"$.contextMenu({",
" selector: '#' + id + ' td.factor input[type=text]',",
" trigger: 'hover',",
" build: function($trigger, e){",
" var levels = $trigger.parent().data('levels');",
" if(levels === undefined){",
" var colindex = table.cell($trigger.parent()[0]).index().column;",
" levels = table.column(colindex).data().unique();",
" }",
" var options = levels.reduce(function(result, item, index, array){",
" result[index] = item;",
" return result;",
" }, {});",
" return {",
" autoHide: true,",
" items: {",
" dropdown: {",
" name: 'Edit',",
" type: 'select',",
" options: options,",
" selected: 0",
" }",
" },",
" events: {",
" show: function(opts){",
" opts.$trigger.off('blur');",
" },",
" hide: function(opts){",
" var $this = this;",
" var data = $.contextMenu.getInputValues(opts, $this.data());",
" var $input = opts.$trigger;",
" $input.val(options[data.dropdown]);",
" $input.trigger('change');",
" }",
" }",
" };",
" }",
"});"
)
createdCell <- function(levels){
if(missing(levels)){
return("function(td, cellData, rowData, rowIndex, colIndex){}")
}
quotedLevels <- toString(sprintf(""%s"", levels))
c(
"function(td, cellData, rowData, rowIndex, colIndex){",
sprintf(" $(td).attr('data-levels', '[%s]');", quotedLevels),
"}"
)
}
ui <- fluidPage(
tags$head(
tags$link(
rel = "stylesheet",
href = "https://cdnjs.cloudflare.com/ajax/libs/jquery-contextmenu/2.8.0/jquery.contextMenu.min.css"
),
tags$script(
src = "https://cdnjs.cloudflare.com/ajax/libs/jquery-contextmenu/2.8.0/jquery.contextMenu.min.js"
)
),
DTOutput("dt"),
br(),
verbatimTextOutput("table"),
br(),
downloadButton('download',"Download the data")
)
server <- function(input, output){
dat <- cars_meta
value <- reactiveValues()
value$dt<-
datatable(
dat, editable = "cell", callback = JS(callback),
options = list(
columnDefs = list(
list(
targets = 2,
className = "factor",
createdCell = JS(createdCell(c(levels(cars_meta$data_class), "another level")))
),
list(
targets = 3,
className = "factor",
createdCell = JS(createdCell(c(levels(cars_meta$usage), "another level")))
)
)
)
)
output[["dt"]] <- renderDT({
value$dt
},
server = TRUE)
Data <- reactive({
info <- input[["dt_cell_edit"]]
if(!is.null(info)){
info <- unique(info)
info$value[info$value==""] <- NA
dat <- editData(dat, info, proxy = "dt")
}
dat
})
#output table to be able to confirm the table updates
output[["table"]] <- renderPrint({Data()})
output$download <- downloadHandler(
filename = function(){"Data.csv"},
content = function(fname){
write.csv(Data(), fname)
}
)
}
shinyApp(ui, server)
library(DT)
library(shiny)
library(dplyr)
cars_df <- mtcars
selectInputIDa <- paste0("sela", 1:length(cars_df))
selectInputIDb <- paste0("selb", 1:length(cars_df))
initMeta <- dplyr::tibble(
variables = names(cars_df),
data_class = sapply(selectInputIDa, function(x){as.character(selectInput(inputId = x, label = "", choices = c("character","numeric", "factor", "logical"), selected = sapply(cars_df, class)))}),
usage = sapply(selectInputIDb, function(x){as.character(selectInput(inputId = x, label = "", choices = c("id", "meta", "demo", "sel", "text"), selected = "sel"))})
)
ui <- fluidPage(
DT::dataTableOutput(outputId = 'my_table'),
br(),
verbatimTextOutput("table")
)
server <- function(input, output, session) {
displayTbl <- reactive({
dplyr::tibble(
variables = names(cars_df),
data_class = sapply(selectInputIDa, function(x){as.character(selectInput(inputId = x, label = "", choices = c("numeric", "character", "factor", "logical"), selected = input[[x]]))}),
usage = sapply(selectInputIDb, function(x){as.character(selectInput(inputId = x, label = "", choices = c("id", "meta", "demo", "sel", "text"), selected = input[[x]]))})
)
})
output$my_table = DT::renderDataTable({
DT::datatable(
initMeta, escape = FALSE, selection = 'none', rownames = FALSE,
options = list(paging = FALSE, ordering = FALSE, scrollx = TRUE, dom = "t",
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
)
)
}, server = TRUE)
my_table_proxy <- dataTableProxy(outputId = "my_table", session = session)
observeEvent({sapply(selectInputIDa, function(x){input[[x]]})}, {
replaceData(proxy = my_table_proxy, data = displayTbl(), rownames = FALSE) # must repeat rownames = FALSE see ?replaceData and ?dataTableAjax
}, ignoreInit = TRUE)
observeEvent({sapply(selectInputIDb, function(x){input[[x]]})}, {
replaceData(proxy = my_table_proxy, data = displayTbl(), rownames = FALSE) # must repeat rownames = FALSE see ?replaceData and ?dataTableAjax
}, ignoreInit = TRUE)
output$table <- renderPrint({displayTbl()})
}
shinyApp(ui = ui, server = server)
推荐答案
要获取resultTbl，您只需访问input[x]的：
library(DT)
library(shiny)
library(dplyr)
cars_df <- mtcars
selectInputIDa <- paste0("sela", 1:length(cars_df))
selectInputIDb <- paste0("selb", 1:length(cars_df))
initMeta <- dplyr::tibble(
variables = names(cars_df),
data_class = sapply(selectInputIDa, function(x){as.character(selectInput(inputId = x, label = "", choices = c("character","numeric", "factor", "logical"), selected = sapply(cars_df, class)))}),
usage = sapply(selectInputIDb, function(x){as.character(selectInput(inputId = x, label = "", choices = c("id", "meta", "demo", "sel", "text"), selected = "sel"))})
)
ui <- fluidPage(
DT::dataTableOutput(outputId = 'my_table'),
br(),
verbatimTextOutput("table")
)
server <- function(input, output, session) {
displayTbl <- reactive({
dplyr::tibble(
variables = names(cars_df),
data_class = sapply(selectInputIDa, function(x){as.character(selectInput(inputId = x, label = "", choices = c("numeric", "character", "factor", "logical"), selected = input[[x]]))}),
usage = sapply(selectInputIDb, function(x){as.character(selectInput(inputId = x, label = "", choices = c("id", "meta", "demo", "sel", "text"), selected = input[[x]]))})
)
})
resultTbl <- reactive({
dplyr::tibble(
variables = names(cars_df),
data_class = sapply(selectInputIDa, function(x){input[[x]]}),
usage = sapply(selectInputIDb, function(x){input[[x]]})
)
})
output$my_table = DT::renderDataTable({
DT::datatable(
initMeta, escape = FALSE, selection = 'none', rownames = FALSE,
options = list(paging = FALSE, ordering = FALSE, scrollx = TRUE, dom = "t",
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
)
)
}, server = TRUE)
my_table_proxy <- dataTableProxy(outputId = "my_table", session = session)
observeEvent({sapply(selectInputIDa, function(x){input[[x]]})}, {
replaceData(proxy = my_table_proxy, data = displayTbl(), rownames = FALSE) # must repeat rownames = FALSE see ?replaceData and ?dataTableAjax
}, ignoreInit = TRUE)
observeEvent({sapply(selectInputIDb, function(x){input[[x]]})}, {
replaceData(proxy = my_table_proxy, data = displayTbl(), rownames = FALSE) # must repeat rownames = FALSE see ?replaceData and ?dataTableAjax
}, ignoreInit = TRUE)
output$table <- renderPrint({resultTbl()})
}
shinyApp(ui = ui, server = server)
这篇关于使用下拉选择在SHILINY中编辑数据表(适用于DT v0.19)的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
