时间戳

首页 > 解决方案 > 为什么 Shiny.onInputChange 在 R Shiny 中有一个不稳定的行为？

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

问题描述

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

以下代码是完全可复现的，只需加载三页代码（ui、serve、global）。然后点击“Click me”，然后点击“Publier”（=publish in french），它将填充文本文件并更新表格。

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

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

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")
))
  )
)

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

全局.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)
}

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

服务器.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)
  })
})

标签： rshiny

解决方案

'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)'.

推荐阅读