r语言 - RShiny:根据数据修改数字输入

Question

这是一个示例代码，我在其中生成随机向量并绘制其直方图。此外，我还有一个 numericInput 字段用于裁剪数据，即将低于阈值的值分配给该阈值。数字输入字段的初始值是根据数据分配的。

问题是，当我按下按钮生成数据时，绘图被评估两次，这是我想避免的。我通过在绘图函数中添加睡眠程序来强调这一点。

在我看来，我错误地更新了数字输入。当我简单地对该字段的初始字段值进行硬编码时，问题就消失了，绘图被评估一次。

library(shiny)
ui <- shinyUI(fluidPage(
  titlePanel("test data clipping"),
  sidebarLayout(
    sidebarPanel(
      actionButton('inDataGen', 'Generate dataset'),
      br(),
      br(),
      uiOutput('resetable_input_clip'),
      actionButton('inDataClipReset', 'Reset data clipping')
    ),
    mainPanel(plotOutput("plotHist", width = "100%"))
  )
))
server <- shinyServer(function(input, output) {
  rValues <- reactiveValues(dataIn = NULL,
                            dataMin = -10e10)
  # generate random dataset
  userDataGen <- observeEvent(input$inDataGen, {
    cat(file = stderr(), 'nuserDataGenn')
    # assign result to shared 'dataIn' variable
    x <- rnorm(1000)
    rValues$dataIn = x
    rValues$dataMin = min(x)
  })
  # modify data
  userDataProc <- reactive({
    cat(file = stderr(), 'userDataProcn')
    dm = rValues$dataIn
    if (is.null(rValues$dataIn))
      return(NULL)
    else {
      # Data clipping
      dm[dm < input$inDataClipMin] <-
        input$inDataClipMin
      return(dm)
    }
  })
  output$resetable_input_clip <- renderUI({
    cat(file = stderr(), 'output$resetable_input_clipn')
    times <- input$inDataClipReset
    div(
      id = letters[(times %% length(letters)) + 1],
      numericInput(
        'inDataClipMin',
        'Clip data below threshold:',
        value = rValues$dataMin,
        width = 200,
        step = 100
      )
    )
  })
  output$plotHist <- renderPlot({
    cat(file = stderr(), 'plotHist n')
    if (is.null(rValues$dataIn))
      return(NULL)
    else {
      plot(hist(userDataProc()))
      Sys.sleep(2)
    }  
  })      
})
shinyApp(ui = ui, server = server)

按下按钮生成数据后的流程涉及两个plotHist评估：

output$resetable_input_clip
plotHist 
userDataGen
plotHist 
userDataProc
output$resetable_input_clip
plotHist 
userDataProc

解决了埃尔索斯此问题已在闪亮的谷歌组上得到解决。最终的解决方案在这里可用，它是将observeEvent + reactiveValues更改为reactive()和使用freezeReactiveValue的组合。

Answer 1

我相信您的问题发生在

# modify data
  userDataProc <- reactive({
    cat(file = stderr(), 'userDataProcn')
    dm = rValues$dataIn
    if (is.null(df))
      return(NULL)
    else {
      # Data clipping
      dm[dm < input$inDataClipMin] <-
        input$inDataClipMin
      return(dm)
    }
  })

由于input$inDataClipMin依赖于rValues$dataMin的反应值，你最终会将其渲染为初始值rValues$dataMin，rValues$dataMin被重新评估，这触发了input$inDataClipMin的重新评估。

如果您将此代码片段替换为我在下面的内容，您应该获得所需的行为。

# modify data
  userDataProc <- reactive({
    cat(file = stderr(), 'userDataProcn')
    dm = rValues$dataIn
    if (is.null(df))
      return(NULL)
    else {
      # Data clipping
      dm[dm < rValues$dataMin] <-
        rValues$dataMin
      return(dm)
    }
  })

作为替代方案，您可以将以下内容放在您的ui

numericInput(
        'inDataClipMin',
        'Clip data below threshold:',
        value = rValues$dataMin,
        width = 200,
        step = 100
      )

然后使用updateNumericInput替换它的值。 但是，这将需要对当前代码进行更多修改，并且根据应用程序中发生的其他情况，无论如何都可能不是理想的解决方案。

Answer 2

这就是我想出的。主要区别在于引入了存储裁剪数据的共享反应变量rValues$dataClip。以前，数据修改是通过反应函数userDataProc实现的。该函数的输出用于绘图，正如@Benjamin所建议的那样，这是绘图双重评估的罪魁祸首。在此版本中，userDataProc转换为监视数字输入字段input$inDataClipMin observeEvent。

library(shiny)
ui <- shinyUI(fluidPage(
  titlePanel("test data clipping"),
  sidebarLayout(
    sidebarPanel(
      actionButton('inDataGen', 'Generate dataset'),
      br(),
      br(),
      uiOutput('resetable_input_clip'),
      actionButton('inDataClipReset', 'Reset data clipping')
    ),
    mainPanel(plotOutput("plotHist", width = "100%"))
  )
))
server <- shinyServer(function(input, output, session) {
  rValues <- reactiveValues(dataIn = NULL,
                            dataClip = NULL,
                            dataMin = -10e10)
  # generate random dataset
  userDataGen <- observeEvent(input$inDataGen, {
    cat(file = stderr(), 'nuserDataGenn')
    # assign result to shared 'dataIn' variable
    x <- rnorm(1000)
    rValues$dataIn = x
    rValues$dataMin = min(x)
  })
  # modify data
  userDataProc <- observeEvent(input$inDataClipMin, {
    cat(file = stderr(), 'userDataProcn')
    dm = rValues$dataIn
    if (is.null(rValues$dataIn))
      rValues$dataClip = NULL
    else {
      dm[dm < input$inDataClipMin] <-
        input$inDataClipMin
      rValues$dataClip <- dm
    }
  })
  output$resetable_input_clip <- renderUI({
    cat(file = stderr(), 'output$resetable_input_clipn')
    times <- input$inDataClipReset
    div(
      id = letters[(times %% length(letters)) + 1],
      numericInput(
        'inDataClipMin',
        'Clip data below threshold:',
        value = rValues$dataMin,
        width = 200,
        step = 100
      )
    )
  })
  output$plotHist <- renderPlot({
    cat(file = stderr(), 'plotHist n')
    if (is.null(rValues$dataClip))
      return(NULL)
    else {
      plot(hist(rValues$dataClip))
      Sys.sleep(2)
    }
  })
})
shinyApp(ui = ui, server = server)

现在，按下按钮生成数据后，只有一次plotHist评估：

output$resetable_input_clip
plotHist 
userDataProc
userDataGen
output$resetable_input_clip
userDataProc
plotHist