提问人：tomB 提问时间：10/19/2023 更新时间：10/31/2023 访问量：29
复选框 statut 中的更改在数据表中的新条目上丢失，反应性和可编辑性？
Changes in checkbox statut are lost on new entry in a datatable reactive and editable?
问：
我正在开发一个用于数据记录的闪亮应用程序。每次观察者看到新发生的事件时，都必须记录一个新条目。这是通过在反应式和可编辑的数据帧中添加一行来在应用程序中翻译的。 现场工作结束后，必须检查数据是否存在潜在的输入错误。大多数时候，这是由另一个人完成的。有时，数据可能会被解释为错误并删除，因为开箱即用。然而，我想让观察者确认开箱即用的数据，以确保它不会被删除。为此，我希望在数据帧中有一个复选框。 如果我手动将数据更改到表格（文本或数字）中，则更改将通过可编辑函数保存（请参阅代码），但是如果我切换复选框，则当我添加新条目时，它将重新初始化为取消切换。 举个例子：
library(shiny)
library(tidyverse)
library(DT)
library(shinyjs)
shinyApp(
ui <- fluidPage(
titlePanel("Reactive table with checkbox editable"),
selectInput("photo","Photo", c("choose"="","Dog", "Shovel", "Cat", "Desk")),
selectInput("description", "Description", c("choose"="","object", "animal")),
actionButton("add_line", "Add a line"),
dataTableOutput("table")
),
server <- function(input, output, session) {
# Function to manage cell changes
editable<- function(input,data) {
observeEvent(input$table_cell_edit, {
info <- input$table_cell_edit
row <- info$row
col <- info$col
value <- info$value
dat <- data()
if (col == 3) {
dat[row, col] <- as.logical(value)
} else {
dat[row, col] <- value
}
data(dat)
})}
# Creating an empty frame
myinitialframe <- data.frame(
Photo = character(),
Description = character(),
Confirmed = character(),
stringsAsFactors = FALSE
)
# Get my empty frame reactive
mydata <- reactiveVal(myinitialframe)
# ajout de ligne
observeEvent(input$add_line, {
new_row <- data.frame(
Photo = input$photo,
Description = input$description,
Confirmed = FALSE
)
newdata <- rbind(new_row,mydata())
mydata(newdata)
})
# Display the table with checkbox in column "Confirmed"
output$table <- DT::renderDataTable({
mydata <- as.data.frame (mydata ())
mydata <- datatable(
mydata,
editable = "cell",
options = list(
columnDefs = list(
list(
targets = c(3),
render = JS(
"function(data, type, row, meta) {",
" if (type === 'display') {",
" return '<input type=\"checkbox\" ' + (data === 'TRUE' ? 'checked' : '') + '/>';",
" }",
" return data;",
"}"
)
)
)
)
)
})
editable(input,mydata)
}
)
我试过：
- shinyInput，例如论坛中提出的，但是当有新行要输入时，由于它不能与反应式表一起使用，因此无法使其正常工作？
- 回调和 JS ：
callback = JS(
"table.on('click', 'input[type=checkbox]', function() {",
" var data = table.cell(this).data();",
" data = !data;",
" table.cell(this).data(data).draw(false);",
"});"
),
shinyjs::runjs(
"shinyjs.toggleCheckbox = function(checkbox) {
var row = checkbox.closest('tr');
var rowIndex = mytable.row(row).index();
var newValue = !mytable.cell(rowIndex, 3).data();
mytable.cell(rowIndex, 3).data(newValue).draw();
};"
)
答：
0赞
Stéphane Laurent
10/20/2023
#1
当 （默认值） 在 中时，这将很难。使用 更容易，并且此选项允许用于添加新行。server = TRUErenderDTserver = FALSEaddRow
此外，您的 JavaScript 代码中存在错误：R 数据已转换为 JavaScript，因此不是在 JavaScript 中获得的值，而是。TRUEtrue
请注意，我在反应式数据帧中保留了该表的副本，以防您想保存它。Dat
library(shiny)
library(DT)
ui <- fluidPage(
titlePanel("Editable table with checkboxes"),
selectInput(
"photo", "Photo", c("choose" = "", "Dog", "Shovel", "Cat", "Desk")
),
selectInput(
"description", "Description", c("choose" = "", "object", "animal")
),
actionButton("add_line", "Add a new line"),
DTOutput("table")
)
myinitialframe <- data.frame(
Photo = character(),
Description = character(),
Confirmed = logical(),
stringsAsFactors = FALSE
)
server <- function(input, output, session) {
# we make a reactice dataframe from `myinitialframe`
Dat <- reactiveVal(myinitialframe)
# but we don't use it in `renderDT` !
output[["table"]] <- renderDT({
datatable(
myinitialframe, rownames = TRUE,
editable = "cell", selection = "none",
options = list(
columnDefs = list(
list(
targets = c(3),
render = JS(
"function(data, type, row, meta) {",
" if (type === 'display') {",
" return '<input type=\"checkbox\" ' + (data ? 'checked' : '') + '/>';",
" }",
" return data;",
"}"
)
)
)
)
)
}, server = FALSE)
# instead we will use a proxy in order to be able to add a new row
proxy <- dataTableProxy("table")
# we use`editData` to update the reactive table
observeEvent(input[["table_cell_edit"]], {
info <- input[["table_cell_edit"]]
dat <- Dat()
new_dat <- editData(dat, info, rownames = TRUE)
Dat(new_dat)
})
# now we handle the adding line feature
# with the help of the `addRow` function
observeEvent(input[["add_line"]], {
new_row <- data.frame(
Photo = input[["photo"]],
Description = input[["description"]],
Confirmed = FALSE
)
new_dat <- rbind(Dat(), new_row)
Dat(new_dat)
rownames(new_row) <- nrow(new_dat)
addRow(proxy, new_row, resetPaging = FALSE)
})
}
shinyApp(ui, server)
编辑：更新“已确认”列
library(shiny)
library(DT)
ui <- fluidPage(
titlePanel("Editable table with checkboxes"),
selectInput(
"photo", "Photo", c("choose" = "", "Dog", "Shovel", "Cat", "Desk")
),
selectInput(
"description", "Description", c("choose" = "", "object", "animal")
),
actionButton("add_line", "Add a new line"),
DTOutput("table")
)
myinitialframe <- data.frame(
Photo = character(),
Description = character(),
Confirmed = integer(),
stringsAsFactors = FALSE
)
callback <- JS(
"table.on('click', 'input[type=checkbox]', function() {",
" var $this = $(this);",
" var row = parseInt($this.attr('name')) + 1;",
" var bit = $this.prop('checked') ? 1 : 0;",
" var info = [{row: row, col: 3, value: bit}];",
" Shiny.setInputValue('table_cell_edit:DT.cellInfo', info);",
"});"
)
server <- function(input, output, session) {
# we make a reactice dataframe from `imynitialframe`
Dat <- reactiveVal(myinitialframe)
# but we don't use in `renderDT` !
output[["table"]] <- renderDT({
datatable(
myinitialframe, rownames = TRUE,
editable = "cell", selection = "none",
callback = callback,
options = list(
columnDefs = list(
list(
targets = c(3),
render = JS(
"function(data, type, row, meta) {",
" if (type === 'display') {",
" return `<input type=\"checkbox\" name=\"${meta.row}\"' + (data ? 'checked' : '') + '/>`;",
" }",
" return data;",
"}"
)
)
)
)
)
}, server = FALSE)
# instead we will use a proxy in order to be able to add a new row
proxy <- dataTableProxy("table")
# we use`editData` to update the reactive table
observeEvent(input[["table_cell_edit"]], {
info <- input[["table_cell_edit"]]
print(info)
dat <- Dat()
new_dat <- editData(dat, info, rownames = TRUE)
Dat(new_dat)
})
# now we handle the adding line feature
# with the help of the `addRow` function
observeEvent(input[["add_line"]], {
new_row <- data.frame(
Photo = input[["photo"]],
Description = input[["description"]],
Confirmed = 0L
)
new_dat <- rbind(Dat(), new_row)
Dat(new_dat)
rownames(new_row) <- nrow(new_dat)
addRow(proxy, new_row, resetPaging = FALSE)
})
}
shinyApp(ui, server)
评论
0赞
tomB
10/27/2023
谢谢你的回答。事实上，使用代理表的代码适用于显示。面板中显示的数据表在添加新行时保持选中该复选框。但是 Dat（） 没有更新，我想使用新的输入和编辑保存数据帧的 .csv。我不知道如何保存更改。我尝试了两种可能性，要么直接在代理表（write_csv2（proxy$x$data， file = path）的.csv中，但它没有用。或者根据代理修改 Dat（） 以将其保存在 （observe（{DT：：replaceData（proxy，Dat or Dat（） or Dat$data）}） 之后，但它也不起作用。
0赞
Stéphane Laurent
10/27/2023
@tomB Strange，由我的代码更新。Dat()
0赞
tomB
10/31/2023
对不起，我想我在上面的评论中还不够清楚。我创建了一个保存按钮，将 Dat（） 转换为 .csv。当我修改文本时，所有更改都会更新。示例：我直接在显示表上将条目“Dog”更改为“Cat”，并且它的工作，Dat（）已更新。但是当我选中显示的表格上的一个框时，该复选框的状态在保存 Dat（） 时保持为 FALSE。当你说 Dat（） 已更新时，它是否也意味着复选框？感谢您的帮助。
0赞
Stéphane Laurent
10/31/2023
@tomB 啊，不......看起来不容易做到。让我考虑一下。
0赞
Stéphane Laurent
10/31/2023
@tomB 查看我的编辑。它有效，但我不得不用 1/0 替换 TRUE/FALSE。
评论