在R Shiny中，如何用observe替换observeEvent？

Posted 2023-03-24

【中文标题】在R Shiny中，如何用observe替换observeEvent？

【英文标题】：In R Shiny, how to replace observeEvent with observe?

【发布时间】：2021-12-21 02:18:57

【问题描述】：

以下几乎 MWE 代码使用 observeEvent 将用户输入链接到三个对象。底部的图像也显示并解释了这三个对象：

第一个对象是用于模拟周期数的滑块输入，称为变量 X。

第二个对象是一个 1x1 矩阵，用户输入一个变量 Y。

第三个对象是一个可垂直扩展的矩阵，用户在其中输入一系列值 X|Y。

绘图的基础计算是一个简单的求和积，用作此 MWE 的占位符简化。

用户输入链接显示在底部的图像中。

在每种情况下，如何将下面 MWE 中使用的两个 observeEvents 替换为 observe？如果可能的话。 （我相信这将为我遇到的另一个问题提供解决方案，基于我对observe 函数所做的研究）。我只在有限的 Shiny 体验中使用过observeEvents。

MWE 代码：

library(dplyr)
library(ggplot2)
library(shiny)
library(shinyMatrix)

sumProd <- function(a, b) 
  c    <- rep(NA, a)
  c[]  <- sum(b[,1], na.rm = T) %*% sum(b[,2],na.rm = T) 
  return(c)


ui <- fluidPage(
  sliderInput('periods', 'Modeled periods (X):', min=1, max=10, value=10),
  matrixInput("matrix1", 
              value = matrix(c(5), nrow = 1, ncol = 1, dimnames = list("Base rate (Y)",NULL)),
              cols =  list(names = FALSE),
              class = "numeric"),
  matrixInput("matrix2",
              value = matrix(c(10,5), nrow = 1, ncol = 2, dimnames = list(NULL,c("X","Y"))),
              rows = list(extend = TRUE, delete = TRUE),
              class = "numeric"),
  plotOutput("plot")
)

server <- function(input, output, session)

  observeEvent(input$periods,
    updateMatrixInput(
      session, inputId = "matrix2", 
      value = matrix(c(input$periods,input$matrix2[1,2]),1,2,dimnames=list(NULL,c("X","Y")))
    )
  )
  
  observeEvent(input$matrix1, 
    tmpMat2 <- c(input$matrix2[,1],input$matrix2[,2])
    tmpMat2[length(input$matrix2)/2+1] <- input$matrix1[,1]
    updateMatrixInput(session,inputId="matrix2",value=matrix(tmpMat2,ncol=2,dimnames=list(NULL,c("X","Y")))
    )
  )
  
  plotData <- reactive(
    tryCatch(
      lapply(seq_len(ncol(input$matrix2)/2), # column counter to set matrix index as it expands
             function(i)
               tibble(
                 Scenario = colnames(input$matrix2)[i*2-1],
                 X = seq_len(input$periods),
                 Y = sumProd(input$periods,input$matrix2[,(i*2-1):(i*2), drop = FALSE])
               )
             ) %>% bind_rows(),
      error = function(e) NULL
    )
  )
  
  output$plot <- renderPlot(
    req(plotData())
    plotData() %>% ggplot() + 
      geom_line(aes(x = X, y = Y, colour = as.factor(Scenario))) +
      theme(legend.title=element_blank())
  )


shinyApp(ui, server)

显示 3 个对象之间的用户输入链接的图像：

【参考方案1】：

我查看了How to listen for more than one event expression within a Shiny observeEvent 的帖子，它很好地说明了observe 和observeEvent 在某些情况下的可互换性。根据那篇文章，我想出了以下observeEvent 与observe 的替换：

sumProd <- function(a, b) 
  c    <- rep(NA, a)
  c[]  <- sum(b[,1], na.rm = T) %*% sum(b[,2],na.rm = T) 
  return(c)


ui <- fluidPage(
  sliderInput('periods', 'Modeled periods (X):', min=1, max=10, value=10),
  matrixInput("matrix1", 
              value = matrix(c(5), nrow = 1, ncol = 1, dimnames = list("Base rate (Y)",NULL)),
              cols =  list(names = FALSE),
              class = "numeric"),
  matrixInput("matrix2",
              value = matrix(c(10,5), nrow = 1, ncol = 2, dimnames = list(NULL,c("X","Y"))),
              rows = list(extend = TRUE, delete = TRUE),
              class = "numeric"),
  plotOutput("plot")
)

server <- function(input, output, session)

  observe(
    input$periods
    if(input$periods!=0)
      isolate(
        updateMatrixInput(
          session, inputId = "matrix2",
          value = matrix(c(input$periods,input$matrix2[1,2]),1,2,dimnames=list(NULL,c("X","Y")))
          )
      )
    
  )

  observe(
    input$matrix1
    if(input$matrix1!=0)
      tmpMat2 <- c(input$matrix2[,1],input$matrix2[,2])
      tmpMat2[length(input$matrix2)/2+1] <- input$matrix1[,1]
      isolate(
        updateMatrixInput(
          session,inputId="matrix2",
          value=matrix(tmpMat2,ncol=2,dimnames=list(NULL,c("X","Y")))
          )
      )
    
  )
  
  plotData <- reactive(
    tryCatch(
      lapply(seq_len(ncol(input$matrix2)/2), # column counter to set matrix index as it expands
             function(i)
               tibble(
                 Scenario = colnames(input$matrix2)[i*2-1],
                 X = seq_len(input$periods),
                 Y = sumProd(input$periods,input$matrix2[,(i*2-1):(i*2), drop = FALSE])
               )
             ) %>% bind_rows(),
      error = function(e) NULL
    )
  )
  
  output$plot <- renderPlot(
    req(plotData())
    plotData() %>% ggplot() + 
      geom_line(aes(x = X, y = Y, colour = as.factor(Scenario))) +
      theme(legend.title=element_blank())
  )


shinyApp(ui, server)