带有 datatable 和 editable 单元格的闪亮应用程序。如何在用户从table中删除行后保存编辑的内容?
Shiny app with datatable with editable cells. How to save the edited content after the user removes rows from the table?
我有一个应用程序使用 plot_click 功能在图表上绘制点并创建 table 来跟踪每个点的坐标。作为应用程序的一部分,我有一个删除按钮,允许用户在需要时删除选定的行。如果删除一行,则会更新绘图。
我在我的 table 中添加了一个列,即 editable,因此用户可以写笔记。我遇到的问题是,当我删除一行时,添加在其他单元格上的注释也会消失。
我认为我必须使用输入 $mytable_cell_edit 更新删除事件,并可能为单元格编辑创建另一个事件,但不确定如何执行此操作。
下面的示例代码
library(shiny)
library(tidyverse)
library(DT)
#UI
ui <- basicPage(
column(width = 3, plotOutput("plot", click = "plot_click", width = "350px", height="700px")),
column(width = 9, DTOutput("mytable")),
actionButton("remove", "remove")
)
#server
server <- function(input, output) {
#click inputs
val <- reactiveValues(
clickx = numeric(),
clicky = numeric(),
shape= 2,
id = numeric(),
id_total = 0
)
mytable <- reactive(
data.frame(`Location X` = round(val$clickx,2),
`Location Y` = round(val$clicky,2),
ID = val$id)
)
#bind clicks
observeEvent(input$plot_click, {
val$clickx = c(val$clickx, input$plot_click$x)
val$clicky = c(val$clicky, input$plot_click$y)
val$id_total <- val$id_total + 1
val$id <- c(val$id, val$id_total)
})
#interactive plot
output$plot <- renderPlot({
plot(c(-25, 25), c(-50, 50), type = "n", axes = T , ylab = "", xlab = "")
points(val$clickx, val$clicky, cex = 2, pch=19, col = "black")
})
#mytable
output$mytable <- renderDT({
datatable(mytable() %>%
mutate(Notes = "") %>%
arrange(desc(ID)) %>%
select(ID, everything()),
editable = list(target = "cell", disable = list(columns = 0:2)),
rownames= F)
})
# remove btn
observeEvent(input$remove, {
req(input$mytable_rows_selected)
selected_ids <- sort(val$id, TRUE)[-input$mytable_rows_selected]
val$clickx <- val$clickx[val$id %in% selected_ids]
val$clicky <- val$clicky[val$id %in% selected_ids]
val$id <- val$id[val$id %in% selected_ids]
})
}
shinyApp(ui, server)
我尝试了与 类似的解决方案,但没有成功。
这似乎有效。对不起,我忘记四舍五入了。
library(shiny)
library(DT)
ui <- basicPage(
br(),
actionButton("remove", "remove", class = "btn-primary"),
br(),
fluidRow(
column(
width = 3,
plotOutput("plot", click = "plot_click", width = "100%", height = "700px")
),
column(
width = 9,
DTOutput("mytable")
)
)
)
callback <- c(
'$("#remove").on("click", function(){',
' table.rows(".selected").remove().draw();',
'});'
)
#server
server <- function(input, output, session) {
mytable <- data.frame(
ID = integer(),
`Location X` = numeric(),
`Location Y` = numeric(),
Notes = character(),
check.names = FALSE
)
ID <- reactiveVal(0L)
Xcoords <- reactiveVal()
Ycoords <- reactiveVal()
#mytable
output[["mytable"]] <- renderDT({
datatable(
mytable,
rownames = FALSE,
editable = list(target = "cell", disable = list(columns = c(0L, 1L, 2L))),
callback = JS(callback)
)
}, server = FALSE)
proxy <- dataTableProxy("mytable")
#bind clicks
observeEvent(input[["plot_click"]], {
x <- input[["plot_click"]][["x"]]
y <- input[["plot_click"]][["y"]]
Xcoords(c(Xcoords(), x))
Ycoords(c(Ycoords(), y))
newRow <- as.data.frame(list(ID() + 1L, x, y, ""))
ID(ID() + 1L)
addRow(proxy, newRow, resetPaging = FALSE)
})
#interactive plot
output[["plot"]] <- renderPlot({
plot(c(-25, 25), c(-50, 50), type = "n", ylab = NA, xlab = NA)
points(Xcoords(), Ycoords(), cex = 2, pch = 19, col = "black")
})
# remove btn
observeEvent(input[["remove"]], {
req(input[["mytable_rows_selected"]])
indices <- input[["mytable_rows_selected"]]
Xcoords(Xcoords()[-indices])
Ycoords(Ycoords()[-indices])
})
}
shinyApp(ui, server)
我有一个应用程序使用 plot_click 功能在图表上绘制点并创建 table 来跟踪每个点的坐标。作为应用程序的一部分,我有一个删除按钮,允许用户在需要时删除选定的行。如果删除一行,则会更新绘图。
我在我的 table 中添加了一个列,即 editable,因此用户可以写笔记。我遇到的问题是,当我删除一行时,添加在其他单元格上的注释也会消失。
我认为我必须使用输入 $mytable_cell_edit 更新删除事件,并可能为单元格编辑创建另一个事件,但不确定如何执行此操作。
下面的示例代码
library(shiny)
library(tidyverse)
library(DT)
#UI
ui <- basicPage(
column(width = 3, plotOutput("plot", click = "plot_click", width = "350px", height="700px")),
column(width = 9, DTOutput("mytable")),
actionButton("remove", "remove")
)
#server
server <- function(input, output) {
#click inputs
val <- reactiveValues(
clickx = numeric(),
clicky = numeric(),
shape= 2,
id = numeric(),
id_total = 0
)
mytable <- reactive(
data.frame(`Location X` = round(val$clickx,2),
`Location Y` = round(val$clicky,2),
ID = val$id)
)
#bind clicks
observeEvent(input$plot_click, {
val$clickx = c(val$clickx, input$plot_click$x)
val$clicky = c(val$clicky, input$plot_click$y)
val$id_total <- val$id_total + 1
val$id <- c(val$id, val$id_total)
})
#interactive plot
output$plot <- renderPlot({
plot(c(-25, 25), c(-50, 50), type = "n", axes = T , ylab = "", xlab = "")
points(val$clickx, val$clicky, cex = 2, pch=19, col = "black")
})
#mytable
output$mytable <- renderDT({
datatable(mytable() %>%
mutate(Notes = "") %>%
arrange(desc(ID)) %>%
select(ID, everything()),
editable = list(target = "cell", disable = list(columns = 0:2)),
rownames= F)
})
# remove btn
observeEvent(input$remove, {
req(input$mytable_rows_selected)
selected_ids <- sort(val$id, TRUE)[-input$mytable_rows_selected]
val$clickx <- val$clickx[val$id %in% selected_ids]
val$clicky <- val$clicky[val$id %in% selected_ids]
val$id <- val$id[val$id %in% selected_ids]
})
}
shinyApp(ui, server)
我尝试了与
这似乎有效。对不起,我忘记四舍五入了。
library(shiny)
library(DT)
ui <- basicPage(
br(),
actionButton("remove", "remove", class = "btn-primary"),
br(),
fluidRow(
column(
width = 3,
plotOutput("plot", click = "plot_click", width = "100%", height = "700px")
),
column(
width = 9,
DTOutput("mytable")
)
)
)
callback <- c(
'$("#remove").on("click", function(){',
' table.rows(".selected").remove().draw();',
'});'
)
#server
server <- function(input, output, session) {
mytable <- data.frame(
ID = integer(),
`Location X` = numeric(),
`Location Y` = numeric(),
Notes = character(),
check.names = FALSE
)
ID <- reactiveVal(0L)
Xcoords <- reactiveVal()
Ycoords <- reactiveVal()
#mytable
output[["mytable"]] <- renderDT({
datatable(
mytable,
rownames = FALSE,
editable = list(target = "cell", disable = list(columns = c(0L, 1L, 2L))),
callback = JS(callback)
)
}, server = FALSE)
proxy <- dataTableProxy("mytable")
#bind clicks
observeEvent(input[["plot_click"]], {
x <- input[["plot_click"]][["x"]]
y <- input[["plot_click"]][["y"]]
Xcoords(c(Xcoords(), x))
Ycoords(c(Ycoords(), y))
newRow <- as.data.frame(list(ID() + 1L, x, y, ""))
ID(ID() + 1L)
addRow(proxy, newRow, resetPaging = FALSE)
})
#interactive plot
output[["plot"]] <- renderPlot({
plot(c(-25, 25), c(-50, 50), type = "n", ylab = NA, xlab = NA)
points(Xcoords(), Ycoords(), cex = 2, pch = 19, col = "black")
})
# remove btn
observeEvent(input[["remove"]], {
req(input[["mytable_rows_selected"]])
indices <- input[["mytable_rows_selected"]]
Xcoords(Xcoords()[-indices])
Ycoords(Ycoords()[-indices])
})
}
shinyApp(ui, server)