r - 为什么 Shiny.onInputChange 在 R shiny 中有不稳定的行为？

Question

我正在构建一个 R shiny 应用程序，它将从用户那里获取一条消息并将其存储在一个文本文件中。该文件将同时显示为表格，用户可以使用内置按钮在其中删除一些消息。这个内置按钮是使用 Shiny.onInputChange 实现的。

下面的代码是完全可重现的，只需加载代码的三个页面(ui、serve、global)。然后单击“单击我”，然后单击“Publier”(法语为 publish)，这将填充文本文件并更新表格。

现在，通过单击“Retirer”(法语中的“删除”)删除行，如果多次执行此操作，您会注意到，有时有效，有时无效，这不是程序应有的行为方式。我无法解释或查明这种不稳定行为的原因。

------------------------

ui.server

# Define UI for application that draws a histogram
shinyUI(fluidPage(

title="Civilia",
theme = "shiny.css",
navbarPage(

########################
fluidPage(
  br(),
  br(),
  br(),
  br(),
    fluidRow(column(12,offset=0,actionButton("prevMessage", label = "Click me"))),
  br(),
  DT::dataTableOutput("data")
))
  )
)

------------------------

global.R

## 
## load.libraries()
suppressMessages(library(shiny))
suppressMessages(library(plotly))
suppressMessages(library(tidyr))
suppressMessages(library(data.table))
suppressMessages(library(dplyr))
suppressMessages(library(lubridate))
suppressMessages(library(DT))

##
## Set global env values
## Client
.GlobalEnv$client <- "STLevis"
## Data storage for message
.GlobalEnv$vault <- "message.txt"
if(!file.exists(vault)) fwrite(file=vault, data.frame(depoTime=as.POSIXct(character()),msg=character(),duration.h=character(),remTime=as.POSIXct(character())))
.GlobalEnv$msg_vault_df <- fread(vault)

##
## colors
.GlobalEnv$civ.col1 <- rgb(60/255, 60/255, 59/255)
.GlobalEnv$civ.col2 <- rgb(145/255, 191/255, 39/255)
.GlobalEnv$civ.axis.col <- list(linecolor = toRGB("lightgrey"),
                                gridcolor = toRGB("darkgrey"),
                                tickcolor = toRGB("darkgrey"),
                                tickfont = list(color="white"),
                                titlefont = list(color="white"))



###################################
## Store the message with its duration
store.message <- function(myMessage,myDuration){
  ## Open the message vault
  msg_vault <- fread(vault)
  ## Change the column class
  msg_vault <- msg_vault %>% mutate(depoTime   = as.character(depoTime),
                                    msg        = as.character(msg), 
                                    duration.h = as.numeric(duration.h), 
                                    remTime    = as.character(remTime))
  ## Create the data to save
  time.now <- Sys.time()
  new_data <- data.frame(depoTime = as.character(time.now),
                         msg = myMessage,
                         duration.h = myDuration,
                         remTime = as.character(time.now + hours(myDuration)))
  ## Append the new message
  new_vault <- rbind(msg_vault,new_data)
  ## Save it
  fwrite(new_vault,file=vault)
}

###################################
## Store the message with its duration
store.message.vault <- function(msg_vault){
  ## Remove the buttons
  msg_vault <- msg_vault %>% select(-Delete)
  ## Save it
  fwrite(msg_vault,file=vault)
}

------------------------

server.R

#######################
## Define server logic
shinyServer(function(input, output, session) {

  msg_vault <- reactiveFileReader(intervalMillis = 100, session = session, filePath = vault, readFunc = fread)

  ## ----------------------------
  ## Listen to the previsualisation button
  observeEvent(input$prevMessage, {
    ## Build the sentence to show to the user
    myMessage  <- "This is a message"
    ## Show the sentence
    showModal(modalDialog(
      title=NULL,
      HTML(myMessage),
      footer = tagList(actionButton("confirmMessage", "Publier"),
                       modalButton("Annuler"))
    ))
  })

  ## ----------------------------
  ## If the message publication has been confirmed
  observeEvent(input$confirmMessage, {
    ## Store the msg
    store.message("this is a message",0)
    ## Notify the user
    showModal(modalDialog("Le message a été publié.",footer=NULL,easyClose = TRUE))
    Sys.sleep(3)
    removeModal()
  })

  ## ----------------------------
  ## Add buttons to the table
  shinyInput <- function(FUN, len, id, ...) {
    inputs <- character(len)
    for (i in seq_len(len)) {
      inputs[i] <- as.character(FUN(paste0(id, i), ...))
    }
    inputs
  }

  ## ----------------------------
  ## Table of messages to display
  observe({
    ## Extract the reactive data
    msg_vault_df <- msg_vault()
    ## Create the table to display
    .GlobalEnv$msg_tbl = data.frame(
      Delete = shinyInput(actionButton, nrow(msg_vault_df), 'button_', label = "Retirer", onclick = 'Shiny.onInputChange(\"select_button\",  this.id)' ),
      depoTime = msg_vault_df$depoTime,
      msg = msg_vault_df$msg,
      duration.h = msg_vault_df$duration.h,
      remTime = msg_vault_df$remTime
    )
    print(msg_tbl)
    ## Push the table to the UI
    output$data <- DT::renderDataTable(
      msg_tbl, server = FALSE, escape = FALSE, selection = 'none',options = list(searching = FALSE,info=FALSE,paging=FALSE)
    )
  })

  ## ----------------------------
  ## Wait for the delete buttons
  observeEvent(input$select_button, {
    ## Chosen row to delete
    print(input$select_button)
    selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][2])
    print(selectedRow)
    ## Remove row
    myMsg_tbl <- .GlobalEnv$msg_tbl
    #print(myMsg_tbl)
    myMsg_tbl <- myMsg_tbl[rownames(myMsg_tbl) != selectedRow, ]
    ## Save the remaining, changing the file will update the table
    store.message.vault(myMsg_tbl)
  })
})

Answer 1

'Shiny.onInputChange(\"select_button\", this.id)' 发送 this.id 到 input$select_button 当你单击按钮。 但是如果您再次单击该按钮，则不会发生任何事情，因为this.id 没有改变。

这等同于 'Shiny.setInputValue(\"select_button\", this.id)'。但是 Shiny.setInputValue 有一个选项可以解决这个问题:{priority: 'event'} 选项。

所以你必须做 onclick = 'Shiny.setInputValue(\"select_button\", this.id, {priority:\"event\"})' 而不是 onclick = 'Shiny.onInputChange(\"select_button\", this.id)'。