Question

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

问题在于，当我按下按钮生成数据时，图表会被评估两次，我想避免。我通过在绘图功能中添加睡眠例程来强调这一点。

在我看来，我错误地更新了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(), '\nuserDataGen\n')

    # assign result to shared 'dataIn' variable
    x <- rnorm(1000)
    rValues$dataIn = x
    rValues$dataMin = min(x)
  })

  # modify data
  userDataProc <- reactive({
    cat(file = stderr(), 'userDataProc\n')

    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_clip\n')

    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

已解决的问题 此问题已在Shiny Google group上解决。最终解决方案可用here，并且可以将observeEvent + reactiveValues更改为reactive()，并使用freezeReactiveValue。

Answer 1

我相信你的问题正在发生在

# modify data
  userDataProc <- reactive({
    cat(file = stderr(), 'userDataProc\n')

    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(), 'userDataProc\n')

    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变为observeEvent，监视input$inDataClipMin数字输入字段。

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(), '\nuserDataGen\n')

    # 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(), 'userDataProc\n')

    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_clip\n')

    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

RShiny：根据数据修改numericInput

2 个答案: