Question

与之前的问题类似： How to listen for more than one event expression within a Shiny eventReactive handler

我想在eventReactive表达式中监听两个事件，但是在这种情况下，一个事件比单个输入更复杂，我不能同时获得简单的第一个事件和第二个更复杂的事件。

第一个事件是/cgroup/memory/slurm/uid_<UISERID>/job_<JOBID>/memory.limit_in_bytes一个actionButton，一旦点击使用input$start自我删除，第二个事件需要两个输入来触发; removeUI()这是一个动作按钮，需要在radioButtons小部件（input$nxt）上勾选一个框来触发事件。

这两个事件都会触发相同的代码，这是我编写的一个函数，可以从数据库中随机生成2张照片。然后，用户必须选择他们最喜欢的两张照片中的哪一张（radioButton input$choice），然后单击actionButton input$choice继续。

我正在努力的路线是 input$nxt 它目前只对第二个表达式rv <- eventReactive(input$start |{req(input$nxt, isolate(input$choice))}, mysample(filenames))作出反应。

如果我不包含{req(input$nxt, isolate(input$choice))}并且有： isolate(input$choice) 然后它对两者反应都很好。

非常感谢任何帮助：

我的完整代码如下：

rv <- eventReactive(input$start |input$nxt, mysample(filenames))

Answer 1

我无法复制您的示例，因此我不确定您的问题是什么（请参见下面的友好提示），但我会尝试根据您的描述进行回答。

但是，首先是第一件事。您说您正在与rv <- eventReactive(input$start |{req(input$nxt, isolate(input$choice))}, mysample(filenames))作斗争，对吗？

好吧，如果我们在使用thing 1 | thing 2比较R中的内容时，R仅比较数字，逻辑或复杂的对象，则必须记住一件事。要了解我的意思，请键入1 | "a"并查看会发生什么。

话虽如此，即使您使用正确的语法，R也将无法计算input$start |{req(input$nxt, isolate(input$choice))}，因为在用户选择“左”或“右”的那一刻，input$choice成为一个字符，并且您将得到与1 | "a"中相同的错误。

当您运行rv <- eventReactive(input$start |input$nxt, mysample(filenames))时，它会起作用，因为input$start和input$nxt的类型相同。

现在，回到您的问题所在：如果我理解正确，则在按“开始”后，将生成两个数字，这些数字将为您提供文件名。然后，您要绘制各个图像，并且用户必须选择他们喜欢的图像。您要基于所选图片更改其他图片，并从其余文件中随机选择。是吗？

如果是这种情况，解决问题的一种方法是拥有两个eventReactive语句。用户按下“开始”后，第一个获得初始的两个数字，另一个根据用户的选择更新这两个初始的一个。

第一个只有一个要求：

rv.init <- eventReactive(input$start, {...})

尽管我们可以在第二个中使用以下内容（尽管在这种情况下input$start是多余的）

  rv.cond <- eventReactive(input$start | input$nxt, {

    req(input$choice)
    ...
  })

您可以看到以下代码的有效示例here：

library(shiny)

ui <- fluidPage(
  # ADDED UI OUTPUTS ----------------------------------------------------------#
  fluidRow(h6("Original Filenames"), verbatimTextOutput("originalFilenames")),
  fluidRow(h6("Remaining Filenames"), verbatimTextOutput("remainingFilenames")),
  fluidRow(h6("Initial Sample"), verbatimTextOutput("initialSample")),
  fluidRow(h6("New Sample - user choice fixed"), verbatimTextOutput("newSample")),
  #----------------------------------------------------------------------------#
  fluidRow(uiOutput(outputId = "uiimg1"), uiOutput(outputId = "uiimg2")),
  fluidRow(uiOutput("radio")),
  fluidRow(uiOutput("nxt")),
  fluidRow(tags$div(HTML("<center>"),
                    actionButton("start", "Start"),
                    'id' = "strtbtn")))

server <- function(input, output) {

  # CHANGES TO THE ORIGINAL FUNCTION ------------------------------------------#

  # Generate file names
  orig.filenames <- 1:10

  # Create a reactive variable with filenames
  ## Reactive in the sense that we will update its values by removing the 
  ## selected ones
  filenames <- reactiveValues(names = orig.filenames)

  # Function to get 1 sample observation out of the remaining filenames
  mysample <- function(x){
    tmp <- sample(x,1)
    filenames$names <- setdiff(filenames$names, tmp)
    if(length(filenames$names) < 3) filenames$names <- orig.filenames
    tmp
  }

  #----------------------------------------------------------------------------#

  # CREATE EMPTY SAMPLE SET 

  files <- reactiveValues(sample = c(NA, NA))

  #----------------------------------------------------------------------------#

  # FIRST eventReactive -------------------------------------------------------#

  # Get initial sample of files when user clicks 'start'
  rv.init <- eventReactive(input$start, {

    ## Generate 1st time LEFT value
    left <- mysample(filenames$names)

    ## Generate 1st time RIGHT value
    right <- mysample(filenames$names)

    ## Create your initial sample in files$files
    tmp <- c(left, right)

    return(tmp)

  })

  # UPDATE SAMPLE SET WITH INITIAL VALUES
  observeEvent(input$start,  files$sample <- rv.init())

  #----------------------------------------------------------------------------#

  # SECOND eventReactive -------------------------------------------------------#

  # Get new sample file, based on user choice
  ## It will only update sample after user selects 'Left' or 'Right'
  rv.cond <- eventReactive(input$start | input$nxt, {

    req(input$choice)
    if (input$choice == "Left") {
      init.tmp <- files$sample
      init.tmp[2] <- mysample(filenames$names)
      tmp <- init.tmp
    }
    # Change first value (left value), if user selects "Right"
    else if (input$choice == "Right") {
      init.tmp <- files$sample
      init.tmp[1] <- mysample(filenames$names)
      tmp <- init.tmp
    }

    return(tmp)

  })

  # UPDATE SAMPLE SET WITH NEW VALUES
  observeEvent(input$nxt,  files$sample <- rv.cond())

  #----------------------------------------------------------------------------#

  observeEvent(input$start,
               {output$uiimg1<- renderUI(column(6, HTML("<center>Left Image"),
                                                fluidRow(imageOutput(outputId = "img1"))))})

  observeEvent(input$start,
               {output$uiimg2<- renderUI(column(6, HTML("<center>Right Image"),
                                                fluidRow(imageOutput(outputId = "img2"))))})

  observeEvent(input$start, 
               {output$nxt <- renderUI(wellPanel(HTML("<center>"),
                                                 actionButton("nxt","Next")))})
  observeEvent(input$start,
               {output$radio<- renderUI(
                 wellPanel(HTML("<center>"), 
                           radioButtons(inputId = "choice",
                                        label = "Which photo do you prefer?",
                                        c("Left", "Right"),
                                        inline = TRUE, selected = character (0)
                           )))})

  observeEvent(input$nxt,
               {output$radio<- renderUI(
                 wellPanel(HTML("<center>"), 
                           radioButtons(inputId = "choice",
                                        label = "Which photo do you prefer?",
                                        c("Left", "Right"),
                                        inline = TRUE, selected = character (0)
                           )))})

  observeEvent(input$start,
               removeUI(selector = "div:has(> #strtbtn)", immediate = TRUE))

  output$img1 <- renderImage({
    filename1 <- tempfile(fileext='.png')

    # CHANGED FROM THE ORIGINAL QUESTION --------------------------------------#
    # Set seed to filenames number from files$sample[1]
    set.seed(files$sample[1])

    # Generate a png
    png(filename1, width=325, height=214)
    hist(rnorm(50*files$sample[1]),  main = paste("Histogram of rnorm(50*" , files$sample[1], ")"))
    dev.off()
    #--------------------------------------------------------------------------#

    list(src = filename1, width=325, height=214)
  }, deleteFile= FALSE)

  output$img2 <- renderImage({
    filename2<- tempfile(fileext='.png')

    # CHANGED FROM THE ORIGINAL QUESTION --------------------------------------#
    # Set seed to filenames number from files$sample[2]
    set.seed(files$sample[2])

    # Generate a png
    png(filename2, width=325, height=214)
    hist(rnorm(50*files$sample[2]),  main = paste("Histogram of rnorm(50*" , files$sample[2], ")"))
    dev.off()
    #--------------------------------------------------------------------------#

    list(src = filename2, width=325, height=214)
  }, deleteFile= FALSE)

  # ADDED SERVER OUTPUTS ------------------------------------------------------#

  ## Print original filenames
  output$originalFilenames <- renderPrint({
    print(orig.filenames)
  })

  ## Print remaining filenames
  output$remainingFilenames <- renderPrint({
    print(filenames$names)
  })

  ## Print Initial Sample
  output$initialSample <- renderPrint({
    print(rv.init())
  })

  ## Print New Sample, keeping user choice fixed
  output$newSample <- renderPrint({
    req(input$start)
    print(files$sample)
  })

}

shinyApp(ui = ui, server = server)

友情提示

添加工作示例时，请确保它是可复制的。例如，我无权访问文件夹/Users/Ben/Documents/Masters/Stats/Shiny/v8/www/，因此我不得不修改您的代码以使其起作用。如果我们花了一些时间来理解/更正您的代码，那么您将需要更长的时间才能获得答案。

有关更多信息，请参见：How to make a great R reproducible example?

除此之外，欢迎来到SO。 =）

如何在闪亮的eventReactive处理程序中侦听包含isolate（）的多个事件

1 个答案:

友情提示