为什么 Shiny.onInputChange 在 R闪亮中具有不稳定的行为？

Question

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

\n\n

以下代码是完全可重现的，只需加载三页代码（ui、serve、global）。然后单击“Click me”，然后单击“Publier”（=用法语发布），这将填充文本文件并更新表格。

\n\n

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

\n\n

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

\n\n

用户界面服务器

\n\n

# Define UI for application that draws a histogram\nshinyUI(fluidPage(\n\ntitle="Civilia",\ntheme = "shiny.css",\nnavbarPage(\n\n########################\nfluidPage(\n  br(),\n  br(),\n  br(),\n  br(),\n    fluidRow(column(12,offset=0,actionButton("prevMessage", label = "Click me"))),\n  br(),\n  DT::dataTableOutput("data")\n))\n  )\n)\n

\n\n

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

\n\n

全局R

\n\n

## \n## load.libraries()\nsuppressMessages(library(shiny))\nsuppressMessages(library(plotly))\nsuppressMessages(library(tidyr))\nsuppressMessages(library(data.table))\nsuppressMessages(library(dplyr))\nsuppressMessages(library(lubridate))\nsuppressMessages(library(DT))\n\n##\n## Set global env values\n## Client\n.GlobalEnv$client <- "STLevis"\n## Data storage for message\n.GlobalEnv$vault <- "message.txt"\nif(!file.exists(vault)) fwrite(file=vault, data.frame(depoTime=as.POSIXct(character()),msg=character(),duration.h=character(),remTime=as.POSIXct(character())))\n.GlobalEnv$msg_vault_df <- fread(vault)\n\n##\n## colors\n.GlobalEnv$civ.col1 <- rgb(60/255, 60/255, 59/255)\n.GlobalEnv$civ.col2 <- rgb(145/255, 191/255, 39/255)\n.GlobalEnv$civ.axis.col <- list(linecolor = toRGB("lightgrey"),\n                                gridcolor = toRGB("darkgrey"),\n                                tickcolor = toRGB("darkgrey"),\n                                tickfont = list(color="white"),\n                                titlefont = list(color="white"))\n\n\n\n###################################\n## Store the message with its duration\nstore.message <- function(myMessage,myDuration){\n  ## Open the message vault\n  msg_vault <- fread(vault)\n  ## Change the column class\n  msg_vault <- msg_vault %>% mutate(depoTime   = as.character(depoTime),\n                                    msg        = as.character(msg), \n                                    duration.h = as.numeric(duration.h), \n                                    remTime    = as.character(remTime))\n  ## Create the data to save\n  time.now <- Sys.time()\n  new_data <- data.frame(depoTime = as.character(time.now),\n                         msg = myMessage,\n                         duration.h = myDuration,\n                         remTime = as.character(time.now + hours(myDuration)))\n  ## Append the new message\n  new_vault <- rbind(msg_vault,new_data)\n  ## Save it\n  fwrite(new_vault,file=vault)\n}\n\n###################################\n## Store the message with its duration\nstore.message.vault <- function(msg_vault){\n  ## Remove the buttons\n  msg_vault <- msg_vault %>% select(-Delete)\n  ## Save it\n  fwrite(msg_vault,file=vault)\n}\n

\n\n

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

\n\n

服务器R

\n\n

#######################\n## Define server logic\nshinyServer(function(input, output, session) {\n\n  msg_vault <- reactiveFileReader(intervalMillis = 100, session = session, filePath = vault, readFunc = fread)\n\n  ## ----------------------------\n  ## Listen to the previsualisation button\n  observeEvent(input$prevMessage, {\n    ## Build the sentence to show to the user\n    myMessage  <- "This is a message"\n    ## Show the sentence\n    showModal(modalDialog(\n      title=NULL,\n      HTML(myMessage),\n      footer = tagList(actionButton("confirmMessage", "Publier"),\n                       modalButton("Annuler"))\n    ))\n  })\n\n  ## ----------------------------\n  ## If the message publication has been confirmed\n  observeEvent(input$confirmMessage, {\n    ## Store the msg\n    store.message("this is a message",0)\n    ## Notify the user\n    showModal(modalDialog("Le message a \xc3\xa9t\xc3\xa9 publi\xc3\xa9.",footer=NULL,easyClose = TRUE))\n    Sys.sleep(3)\n    removeModal()\n  })\n\n  ## ----------------------------\n  ## Add buttons to the table\n  shinyInput <- function(FUN, len, id, ...) {\n    inputs <- character(len)\n    for (i in seq_len(len)) {\n      inputs[i] <- as.character(FUN(paste0(id, i), ...))\n    }\n    inputs\n  }\n\n  ## ----------------------------\n  ## Table of messages to display\n  observe({\n    ## Extract the reactive data\n    msg_vault_df <- msg_vault()\n    ## Create the table to display\n    .GlobalEnv$msg_tbl = data.frame(\n      Delete = shinyInput(actionButton, nrow(msg_vault_df), \'button_\', label = "Retirer", onclick = \'Shiny.onInputChange(\\"select_button\\",  this.id)\' ),\n      depoTime = msg_vault_df$depoTime,\n      msg = msg_vault_df$msg,\n      duration.h = msg_vault_df$duration.h,\n      remTime = msg_vault_df$remTime\n    )\n    print(msg_tbl)\n    ## Push the table to the UI\n    output$data <- DT::renderDataTable(\n      msg_tbl, server = FALSE, escape = FALSE, selection = \'none\',options = list(searching = FALSE,info=FALSE,paging=FALSE)\n    )\n  })\n\n  ## ----------------------------\n  ## Wait for the delete buttons\n  observeEvent(input$select_button, {\n    ## Chosen row to delete\n    print(input$select_button)\n    selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][2])\n    print(selectedRow)\n    ## Remove row\n    myMsg_tbl <- .GlobalEnv$msg_tbl\n    #print(myMsg_tbl)\n    myMsg_tbl <- myMsg_tbl[rownames(myMsg_tbl) != selectedRow, ]\n    ## Save the remaining, changing the file will update the table\n    store.message.vault(myMsg_tbl)\n  })\n})\n

\n

Answer 1

'Shiny.onInputChange(\"select_button\", this.id)'单击按钮时发送this.id到。但是，如果您第二次单击该按钮，则什么也不会发生，因为没有改变。input$select_buttonthis.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)'.