私は、ユーザーがデータテーブルを制御できるRShinyアプリに取り組んでいます。テーブルに新しい行を追加したり、既存の行を削除したりできます。私の望みは、ユーザーがこのボタンをクリックできるテーブルに[削除]ボタンを埋め込んで、その行を削除することです。
以下は私のソリューションの現在のステータスですが、一貫して機能していません。追加ボタンは一貫して機能しますが、削除ボタンが認識されない場合があります。
`` `
library(DT)
getRemoveButtons <- function(n, idS = "", lab = "Pit") {
if (stringr::str_length(idS) > 0) idS <- paste0(idS, "-")
ret <- shinyInput(actionButton, n,
'button_', label = "Remove",
onclick = sprintf('Shiny.onInputChange(\"%sremove_button_%s\", this.id)' ,idS, lab))
return (ret)
}
shinyInput <- function(FUN, len, id, ses, ...) {
inputs <- character(len)
for (i in seq_len(len)) {
inputs[i] <- as.character(FUN(paste0(id, i), ...))
}
inputs
}
ui = shinyUI(fluidPage(
fluidRow(DT::dataTableOutput("myTable")),
fluidRow(actionButton("addRow", label = "Add Row",
icon = icon("plus"))))
)
server = function(input, output) {
values <- reactiveValues()
values$tab <- tibble(
Row = 1:3L,
Remove = getRemoveButtons(3, idS = "", lab = "Tab1"))
proxyTable <- DT::dataTableProxy("tab")
output$myTable <- DT::renderDataTable({
DT::datatable(values$tab,
options = list(pageLength = 25,
dom = "rt"),
rownames = FALSE,
escape = FALSE,
editable = TRUE)
})
observeEvent(input$remove_button_Tab1, {
myTable <- values$tab
s <- as.numeric(strsplit(input$remove_button_Tab1, "_")[[1]][2])
myTable <- filter(myTable, row_number() != s)
myTable <-
mutate(myTable,
Remove = getRemoveButtons(nrow(myTable), idS = "", lab = "Tab1"))
replaceData(proxyTable, myTable, resetPaging = FALSE)
values$tab <- myTable
})
observeEvent(input$addRow, {
myTable <- isolate(values$tab)
myTable <- select(myTable, Row)
myTable <- bind_rows(
myTable,
tibble(Row = nrow(myTable) + 1))
myTable <- mutate(myTable,
Remove = getRemoveButtons(nrow(myTable), idS = "", lab = "Tab1"))
replaceData(proxyTable, myTable, resetPaging = FALSE)
values$tab <- myTable
})
}
shinyApp(ui = ui, server = server)
わかりました、今は動作しています。問題は、ボタンのIDを再利用しようとしたことでした。カウンターを作成し、新しいボタンごとに、これまで使用されたことのないIDを割り当てることで、完全に機能するようになりました。以下の変更されたコード。
`` `
library(DT)
library(dplyr)
getRemoveButton <- function(n, idS = "", lab = "Pit") {
if (stringr::str_length(idS) > 0) idS <- paste0(idS, "-")
ret <- shinyInput(actionButton, n,
'button_', label = "Remove",
onclick = sprintf('Shiny.onInputChange(\"%sremove_button_%s\", this.id)' ,idS, lab))
return (ret)
}
shinyInput <- function(FUN, n, id, ses, ...) {
as.character(FUN(paste0(id, n), ...))
}
ui = shinyUI(fluidPage(
fluidRow(DT::dataTableOutput("myTable")),
fluidRow(actionButton("addRow", label = "Add Row",
icon = icon("plus"))))
)
server = function(input, output) {
buttonCounter <- 3L
values <- reactiveValues()
values$tab <- tibble(
Row = 1:3L,
id = 1:3L) %>%
rowwise() %>%
mutate(Remove = getRemoveButton(id, idS = "", lab = "Tab1"))
proxyTable <- DT::dataTableProxy("tab")
output$myTable <- DT::renderDataTable({
DT::datatable(values$tab,
options = list(pageLength = 25,
dom = "rt"),
rownames = FALSE,
escape = FALSE,
editable = TRUE)
})
observeEvent(input$remove_button_Tab1, {
myTable <- values$tab
s <- as.numeric(strsplit(input$remove_button_Tab1, "_")[[1]][2])
myTable <- filter(myTable, id != s)
replaceData(proxyTable, myTable, resetPaging = FALSE)
values$tab <- myTable
})
observeEvent(input$addRow, {
buttonCounter <<- buttonCounter + 1L
myTable <- isolate(values$tab)
myTable <- bind_rows(
myTable,
tibble(Row = nrow(myTable) + 1) %>%
mutate(id = buttonCounter,
Remove = getRemoveButton(buttonCounter, idS = "", lab = "Tab1")))
replaceData(proxyTable, myTable, resetPaging = FALSE)
values$tab <- myTable
})
}
shinyApp(ui = ui, server = server)
この記事はインターネットから収集されたものであり、転載の際にはソースを示してください。
侵害の場合は、連絡してください[email protected]
コメントを追加