Оставляя в стороне ваши ограничения версии, вот как я бы подошел к этому с последней library(DT) версией (надеюсь, полезной для будущих читателей и, возможно, когда-нибудь вы тоже обновитесь):
Редактировать : теперь используется dataTableProxy, чтобы избежать повторного рендеринга.
library(shiny)
library(DT)
ui <- shinyUI(
fluidPage(
radioButtons(inputId = "rdo_cyl",
label = "Cylinders",
choices = sort(unique(mtcars$cyl)),
inline = TRUE),
h3("Automatic"),
actionButton(inputId = "btn_save_automatic",
label = "Save Comments"), p(),
DTOutput("am0"),
hr(),
h3("Manual"),
actionButton(inputId = "btn_save_manual",
label = "Save Comments"), p(),
DTOutput("am1")
)
)
server <- shinyServer(function(input, output, session){
globalData <- mtcars
globalData$comment <- rep("", nrow(mtcars))
globalData$row_id <- seq_len(nrow(mtcars))
diabledCols <- grep("comment", names(globalData), invert = TRUE)
AppData <- reactiveVal(globalData)
automaticAppData <- reactive({
AppData()[AppData()[["cyl"]] %in% input$rdo_cyl & AppData()[["am"]] %in% "0", ]
})
manualAppData <- reactive({
AppData()[AppData()[["cyl"]] %in% input$rdo_cyl & AppData()[["am"]] %in% "1", ]
})
output$am0 <- DT::renderDT(
# isolate: render only once
expr = {isolate(automaticAppData())},
editable = list(target = "cell", disable = list(columns = diabledCols))
)
output$am1 <- DT::renderDT(
# isolate: render only once
expr = {isolate(manualAppData())},
editable = list(target = "cell", disable = list(columns = diabledCols))
)
observeEvent(input$btn_save_automatic, {
info = input$am0_cell_edit
str(info)
i = automaticAppData()$row_id[[info$row]]
j = info$col
v = info$value
globalData[i, j] <<- DT::coerceValue(v, globalData[i, j])
AppData(globalData)
# update database...
})
observeEvent(input$btn_save_manual, {
info = input$am1_cell_edit
str(info)
i = manualAppData()$row_id[[info$row]]
j = info$col
v = info$value
globalData[i, j] <<- DT::coerceValue(v, globalData[i, j])
AppData(globalData)
# update database...
})
am0Proxy <- dataTableProxy("am0")
am1Proxy <- dataTableProxy("am1")
observeEvent(automaticAppData(), {
replaceData(am0Proxy, automaticAppData(), resetPaging = FALSE)
})
observeEvent(manualAppData(), {
replaceData(am1Proxy, manualAppData(), resetPaging = FALSE)
})
})
shinyApp(ui = ui, server = server)
Здесь - некоторые связанная информация.
Обновление для DT версии 0.2
Вот еще одно решение, более близкое к вашему исходному коду. Я использую isolate(), dataTableProxy() и replaceData(), которые доступны с DT версии 0.2 , чтобы избежать повторного рендеринга таблицы, что решает проблему с привязкой и должно быть быстрее.
Другая проблема в вашем коде заключалась в том, что вы дважды вызывали session$sendCustomMessage("unbind-DT", "am0") вместо того, чтобы использовать его для "am1".
library(shiny)
library(DT)
library(dplyr)
mtcars$comment <- rep("", nrow(mtcars))
mtcars$row_id <- seq_len(nrow(mtcars))
AppData <- split(mtcars, mtcars[c("cyl", "am")])
# Makes a text input column out of a data frame
make_inputtable <- function(df){
df$comment <-
mapply(
function(comment, id){
as.character(textInput(inputId = sprintf("txt_comment_%s", id),
label = "",
value = comment))
},
comment = df$comment,
id = df$row_id,
SIMPLIFY = TRUE)
df
}
ui <- shinyUI(
fluidPage(
radioButtons(inputId = "rdo_cyl",
label = "Cylinders",
choices = sort(unique(mtcars$cyl)),
inline = TRUE),
h3("Automatic"),
actionButton(inputId = "btn_save_automatic",
label = "Save Comments"),
DT::dataTableOutput("am0"),
hr(),
h3("Manual"),
actionButton(inputId = "btn_save_manual",
label = "Save Comments"),
DT::dataTableOutput("am1"),
# unbind a datatable. Needs to be done before a table is redrawn.
tags$script(HTML(
"Shiny.addCustomMessageHandler('unbind-DT', function(id) {
Shiny.unbindAll($('#'+id).find('table').DataTable().table().node());
})"))
)
)
server <- shinyServer(function(input, output, session){
reactiveData <- reactiveValues(
am0_cyl4 = AppData[["4.0"]],
am0_cyl6 = AppData[["6.0"]],
am0_cyl8 = AppData[["8.0"]],
am1_cyl4 = AppData[["4.1"]],
am1_cyl6 = AppData[["6.1"]],
am1_cyl8 = AppData[["8.1"]]
)
# Reactive Objects ------------------------------------------------
ref0 <- reactive({
sprintf("am0_cyl%s", input$rdo_cyl)
})
data0 <- reactive({
reactiveData[[ref0()]]
})
ref1 <- reactive({
sprintf("am1_cyl%s", input$rdo_cyl)
})
data1 <- reactive({
reactiveData[[ref1()]]
})
# Event Observers -------------------------------------------------
observeEvent(
input$btn_save_automatic,
{
in_field <- names(input)[grepl("^txt_comment_", names(input))]
in_field_id <- sub("^txt_comment_", "", in_field)
in_field_id <- as.numeric(in_field_id)
in_field_id <- in_field_id[in_field_id %in% data0()$row_id]
exist_frame <- data0()[c("row_id", "comment")]
new_frame <-
data.frame(
row_id = in_field_id,
comment = vapply(in_field_id,
function(id){ input[[sprintf("txt_comment_%s", id)]]},
character(1)),
stringsAsFactors = FALSE)
Compare <- left_join(exist_frame,
new_frame,
by = "row_id",
suffix = c("_exist", "_new")) %>%
filter(comment_exist != comment_new)
message(sprintf("* %s comment(s) saved", nrow(Compare)))
# Only perform the save operations if there are changes to be made.
if (nrow(Compare)){
session$sendCustomMessage("unbind-DT", "am0")
for(i in seq_len(nrow(Compare))){
row <- Compare$row_id
reactiveData[[ref0()]]$comment[reactiveData[[ref0()]]$row_id == row] <-
input[[sprintf("txt_comment_%s", row)]]
}
print(data0())
}
}
)
# Very similar to btn_save_automatic
observeEvent(
input$btn_save_manual,
{
in_field <- names(input)[grepl("^txt_comment_", names(input))]
in_field_id <- sub("^txt_comment_", "", in_field)
in_field_id <- as.numeric(in_field_id)
in_field_id <- in_field_id[in_field_id %in% data1()$row_id]
exist_frame <- data1()[c("row_id", "comment")]
new_frame <-
data.frame(
row_id = in_field_id,
comment = vapply(in_field_id,
function(id){ input[[sprintf("txt_comment_%s", id)]]},
character(1)),
stringsAsFactors = FALSE)
Compare <- left_join(exist_frame,
new_frame,
by = "row_id",
suffix = c("_exist", "_new")) %>%
filter(comment_exist != comment_new)
message(sprintf("* %s comment(s) saved", nrow(Compare)))
# Only perform the save operations if there are changes to be made.
if (nrow(Compare)){
session$sendCustomMessage("unbind-DT", "am1")
for(i in seq_len(nrow(Compare))){
row <- Compare$row_id
reactiveData[[ref1()]]$comment[reactiveData[[ref1()]]$row_id == row] <-
input[[sprintf("txt_comment_%s", row)]]
}
print(data1())
}
}
)
# Output Objects --------------------------------------------------
output$am0 <-
DT::renderDataTable({
# isolate: render table only once!
make_inputtable(isolate(data0())) %>%
datatable(escape = -13,
options = list(preDrawCallback = DT::JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = DT::JS('function() { Shiny.bindAll(this.api().table().node()); } ')))
}, server = TRUE)
output$am1 <-
DT::renderDataTable({
# isolate: render table only once!
make_inputtable(isolate(data1())) %>%
datatable(escape = -13,
options = list(preDrawCallback = DT::JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = DT::JS('function() { Shiny.bindAll(this.api().table().node()); } ')))
}, server = TRUE)
am0Proxy <- dataTableProxy("am0")
am1Proxy <- dataTableProxy("am1")
observeEvent(data0(), {
replaceData(am0Proxy, make_inputtable(data0()), resetPaging = FALSE) # important
}, ignoreInit = TRUE)
observeEvent(data1(), {
replaceData(am1Proxy, make_inputtable(data1()), resetPaging = FALSE) # important
}, ignoreInit = TRUE)
})
shinyApp(ui = ui, server = server)