R Shiny 删除按钮进入数据 table 效果不佳

Question

我构建了一个闪亮的应用程序，允许用户使用表单更新数据table。我在使用一项功能时遇到了一些麻烦，该功能允许用户通过单击渲染数据 table 中的 actionLink 来删除 datable 中的一行 table。

它工作正常，但我解决了一些错误。当所有数据table 删除一次后，我将新条目放入第一个新条目是非删除table，而没有先删除另一行。

这里要清楚的是显示错误的步骤：

添加文本输入并将其添加到数据中table
删除输入
添加新的文本输入
尝试删除它
添加另一个文本输入
删除第二个新输入
删除第一个输入

我不明白为什么，我认为它来自反应值，但我将观察事件放在唯一可能出现的两个事件上。

这是一个可重现的例子来查看错误：

library(shiny)
library(DT)
library(shinydashboard)
library(shinyjs)



# ----- function which create the button into the table
shinyInput <- function(FUN, len, id, ...) {
  inputs <- len
  for (i in seq(len)) {
    inputs[i] <- as.character(FUN(paste0(id, len[i]), ...))
  }
  inputs
}

# ----- character form vector
fields<-c("text")


ui<-shinyUI(bootstrapPage(
  shinyjs::useShinyjs(),
  title = "Update form",
  fluidRow(
    sidebarPanel(width=2,
                 title = "Submit form", id = "submitTab", value = "submitTab",
                 textInput("text", "Text Input", ""),
                 actionButton("submit", "Add", class = "btn-primary",icon=icon("table"))
                 #     verbatimTextOutput("test")
    ),
    mainPanel(dataTableOutput("data_table")))

))

server<-shinyServer(function(input, output) {  
# ----- create the reactive value  
  v<-reactiveValues(data=NULL)  

# ----- when Add button is clicked
  observeEvent(input$submit, {
    dat <- sapply(fields, function(x) input[[x]])
    dat<-data.frame(t(dat),stringsAsFactors=F)
    if(!(is.null(v$data)) && (input$text%in%v$data$text==F)) {
      v$data <- rbind(v$data[,-2], dat)
    } else if(!is.null(v$data) && (input$text%in%v$data$text==T)) {
      indice<-which(v$data$text==input$text)
      v$data[indice,-2] <- dat
    } else {
      v$data<-dat
    }
    v$data<-data.frame(v$data[,-2],Delete = shinyInput(actionLink, rownames(v$data), 'button_',class="btn btn-delete",icon=icon("minus-circle"),label="",onclick = 'Shiny.onInputChange(\"select_button\",  this.id)' ))
  })

# ----- When Delete table button is clicked 
  observeEvent(input$select_button, {
    #     dat<-v$data
    selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][2])    
    #     dat <- dat[rownames(dat) != selectedRow, ] 
    v$data<-v$data[rownames(v$data)!=selectedRow,]
    v$data<-data.frame(v$data[,-2],Delete = shinyInput(actionLink, rownames(v$data), 'button_',class="btn btn-delete",icon=icon("minus-circle"),label="",onclick = 'Shiny.onInputChange(\"select_button\",  this.id)' ))
  })

# ----- Render the data table
  output$data_table <- renderDataTable(server = TRUE,escape=F,extensions = 'TableTools',options = list(pageLength = 10),{
    if (is.null(v$data)) return()
    v$data
  })  
})

shinyApp(ui,server)

Answer 1

您好，我认为第 4 步的问题是 input$select_button 的值没有改变，将时间粘贴到 this.id 似乎可以解决问题。查看下面的代码（我做了一些其他更改）：

library(shiny)
library(DT)
library(shinydashboard)
library(shinyjs)



# ----- function which create the button into the table
shinyInput <- function(FUN, len, id, ...) {
  inputs <- len
  for (i in seq(len)) {
    inputs[i] <- as.character(FUN(paste0(id, len[i]), ...))
  }
  inputs
}

# ----- character form vector
fields<-c("text")


ui<-shinyUI(bootstrapPage(
  shinyjs::useShinyjs(),
  title = "Update form",
  fluidRow(
    sidebarPanel(width=2,
                 title = "Submit form", id = "submitTab", value = "submitTab",
                 textInput("text", "Text Input", ""),
                 actionButton("submit", "Add", class = "btn-primary",icon=icon("table"))
                 #     verbatimTextOutput("test")
    ),
    mainPanel(dataTableOutput("data_table"), verbatimTextOutput("test")))

))

server<-shinyServer(function(input, output) {  
  # ----- create the reactive value  
  v<-reactiveValues(data=NULL)  

  # ----- when Add button is clicked
  observeEvent(input$submit, {
    dat <- sapply(fields, function(x) input[[x]])
    dat<-data.frame(V1 = dat,stringsAsFactors=F)
    if(!(is.null(v$data)) && (!input$text %in% v$data$text)) {
      v$data <- rbind(data.frame(V1 = as.character(v$data[,1])), dat)
      rownames(v$data) <- seq_len(nrow(v$data))
    } else if(!is.null(v$data) && (input$text %in% v$data$text)) {
      indice<-which(v$data$text==input$text)
      v$data[indice,-2] <- dat
    } else {
      v$data<-dat
    }
    v$data<-data.frame(V1 = v$data[,-2],
                       Delete = shinyInput(actionLink, 
                                       rownames(v$data), 
                                       'button_',
                                       class="btn btn-delete",
                                       icon=icon("minus-circle"),
                                       label="",
                                       onclick = 'Shiny.onInputChange(\"select_button\",  (this.id + \"@\" + Date()))' ))
  })

  # ----- When Delete table button is clicked 
  observeEvent(input$select_button, {
    #     dat<-v$data
    input_button <- gsub(pattern = "@.*", replacement = "", x = input$select_button)
    selectedRow <- as.numeric(strsplit(input_button, "_")[[1]][2])    
    #     dat <- dat[rownames(dat) != selectedRow, ] 
    v$data <- v$data[!rownames(v$data) %in% selectedRow,]
    if (nrow(v$data) > 0) {
      v$data<-data.frame(V1 = v$data[,-2],
                         Delete = shinyInput(actionLink,  
                                         rownames(v$data), 
                                         'button_',
                                         class="btn btn-delete",
                                         icon=icon("minus-circle"),
                                         label="",
                                         onclick = 'Shiny.onInputChange(\"select_button\",  (this.id + \"@\" + Date()))' ))
    }
  })
  output$test <- renderPrint({input$select_button})
  # ----- Render the data table
  output$data_table <- renderDataTable(server = TRUE,escape=F,extensions = 'TableTools',options = list(pageLength = 10),{
    if (is.null(v$data)) return()
    v$data
  })  
})

shinyApp(ui,server)

R Shiny 删除按钮进入数据 table 效果不佳

R Shiny delete button into data table doesn't work well

r

shiny

action-button