在 R Shiny 中，如何使用观察事件在链接的输入矩阵之间建立下游反应链？答案

【问题标题】：In R Shiny, how to establish a downstream reactivity chain among linked input matrices using Observe Events?在 R Shiny 中，如何使用观察事件在链接的输入矩阵之间建立下游反应链？
【发布时间】：2021-12-12 00:15:15
【问题描述】：

以下“已解决的代码”解决了我的原始问题（原始问题显示在此“已解决的代码”下方）。基本上我解析observeEvents 中的上游矩阵值，然后将它们下游到相同observeEvent 中的适用矩阵。但是我问：这种非渲染UI方法是否比“https://stackoverflow.com/questions/69718072/in-r-shiny-how-to-establish-a-reactivity-chain-”中显示的renderUI方法更好？ for-a-series-of-linked-matrix-in"？

解决的代码：

ui <- fluidPage(
  sliderInput('periods', 'Modeled periods (X):', min=1, max=10, value=10),
  
  h5(strong("Matrix 1 is omitted for MWE")), 
  
  h5(strong("Matrix 2:")), 
  matrixInput("matrix2",
              value = matrix(c(10, 5), 1, 2, dimnames = list(NULL,c("X","Y"))),
              rows = list(extend = TRUE, names = TRUE, delete = TRUE),
              class = "numeric"),
  
  h5(strong("Matrix 3:")), 
  matrixInput("matrix3",
              value = matrix(c(10,5), ncol = 2, dimnames = list(NULL, rep("Scenario 1", 2))),
              rows = list(extend = TRUE, delta = 1, names = TRUE, delete = TRUE),
              cols = list(extend = TRUE, delta = 2, names = TRUE, delete = TRUE, multiheader = TRUE),
              class = "numeric"),
  
  plotOutput("plot")
)

server <- function(input, output, session){
  
  observeEvent(input$periods, {
    updateMatrixInput(session, inputId = "matrix2", 
      value = matrix(c(input$periods, 5), 1, 2, dimnames = list(NULL,c("X","Y"))))
  })
  
  observeEvent(input$matrix2, { 
    if(any(rownames(input$matrix2) == "")){
      tmpMatrix <- input$matrix2
      rownames(tmpMatrix) <- paste("Row", seq_len(nrow(input$matrix2)))
      isolate(updateMatrixInput(session, inputId = "matrix2", value = tmpMatrix))
      isolate(updateMatrixInput(session, inputId = "matrix3", 
        value = tmpMatrix))
      }
    input$matrix2
    isolate(
      updateMatrixInput(
        session, 
        inputId = "matrix3", 
        value = matrix(
          c(input$matrix2[,1],input$matrix2[,2]), 
          ncol = 2, 
          dimnames = list(NULL, rep("Scenario 1", 2)))
      )
    )
  })
  
  observeEvent(input$matrix3, {
    if(any(colnames(input$matrix3) == "")){
      tmpMatrix <- input$matrix3
      colnames(tmpMatrix) <- paste("Scenario",rep(1:ncol(tmpMatrix),each=2,length.out=ncol(tmpMatrix)))
      isolate(updateMatrixInput(session, inputId = "matrix3", value = tmpMatrix))
    }
    
    input$matrix3
  })
  
  plotData <- reactive({
    req(input$periods)
    tryCatch(
      lapply(seq_len(ncol(input$matrix3)/2), # column counter to set matrix index as it expands
             function(i){
               tibble(
                 Scenario = colnames(input$matrix3)[i*2-1],
                 X = seq_len(input$periods),
                 Y = interpol(input$periods,input$matrix3[,(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)

这是我今天早些时候发布的后续文章“https://stackoverflow.com/questions/69718072/in-r-shiny-how-to-establish-a-reactivity-chain-for-a-series -of-linked-matrix-in”。在那篇文章的代码中，我使用renderUI 作为矩阵及其链接，它运行良好（由 ismirsehregal 更正）。我正在尝试远离renderUI（为简单起见）并在observeEvent 中使用updateMatrixInput，以便在没有renderUI 的情况下维持反应链。

下面没有渲染UI 的代码几乎和之前发布的renderUI 版本一样工作，除了我无法让滑块输入input$periods 反应性地下游到矩阵，如下图所示。此外，我在下面的代码中丢失了 Matrix 3 的顺序列标题的自动生成，如图所示。

基本上，我不知道如何将输入解析或子集化为updateMatrixInput；在起草以下代码时，它采用了下游的整组矩阵值，从而引发了我的问题。如果我可以告诉它要更新哪些矩阵行/列，那么它会起作用。

如果无法进行解析/子集化，这种情况下的答案可能是坚持使用renderUI？

代码：

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

interpol <- function(a, b) { # [a] = modeled periods, [b] = matrix inputs
  c <- b
  c[,1][c[,1] > a] <- a
  d <- diff(c[,1, drop = FALSE])
  d[d <= 0] <- NA
  d <- c(1,d)
  c <- cbind(c,d)
  c <- na.omit(c)
  c <- c[,-c(3),drop=FALSE]
  e <- rep(NA, a)
  e[c[,1]] <- c[,2]
  e[seq_len(min(c[,1])-1)] <- e[min(c[,1])]
  if(max(c[,1]) < a){e[seq(max(c[,1]) + 1, a, 1)] <- 0}
  e <- approx(seq_along(e)[!is.na(e)], e[!is.na(e)], seq_along(e))$y # Interpolates
  return(e)
}

ui <- fluidPage(
  sliderInput('periods', 'Modeled periods (X):', min=1, max=10, value=10),
  
  h5(strong("Matrix 1 is omitted for MWE")), 
  
  h5(strong("Matrix 2:")), 
  matrixInput("matrix2",
              value = matrix(c(10, 5), 1, 2, dimnames = list(NULL,c("X","Y"))),
              rows = list(extend = TRUE, names = TRUE, delete = TRUE),
              class = "numeric"),
  
  h5(strong("Matrix 3:")), 
  matrixInput("matrix3",
              value = matrix(c(10, 5), ncol = 2, dimnames = list(NULL, rep("Scenario 1", 2))),
              rows = list(extend = TRUE, delta = 1, names = TRUE, delete = TRUE),
              cols = list(extend = TRUE, delta = 2, names = TRUE, delete = TRUE, multiheader = TRUE),
              class = "numeric"),
  
  plotOutput("plot")
)

server <- function(input, output, session){
  
  observeEvent(input$matrix2, { 
    if(any(rownames(input$matrix2) == "")){
      tmpMatrix <- input$matrix2
      rownames(tmpMatrix) <- paste("Row", seq_len(nrow(input$matrix2)))
      isolate(updateMatrixInput(session, inputId = "matrix2", value = tmpMatrix))
      isolate(updateMatrixInput(session, inputId = "matrix3", value = tmpMatrix))
    }
    input$matrix2
    isolate(updateMatrixInput(session, inputId = "matrix3", value = input$matrix2))
  })
  
  observeEvent(input$matrix3, {
    if(any(colnames(input$matrix3) == "")){
      tmpMatrix <- input$matrix3
      colnames(tmpMatrix) <- paste("Scenario",rep(1:ncol(tmpMatrix),each=2,length.out=ncol(tmpMatrix)))
      isolate(updateMatrixInput(session, inputId = "matrix3", value = tmpMatrix))
    }
    
    input$matrix3
  })
  
  plotData <- reactive({
    req(input$periods)
    tryCatch(
      lapply(seq_len(ncol(input$matrix3)/2), # column counter to set matrix index as it expands
             function(i){
               tibble(
                 Scenario = colnames(input$matrix3)[i*2-1],
                 X = seq_len(input$periods),
                 Y = interpol(input$periods,input$matrix3[,(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)

【问题讨论】：

您对input$periods 的唯一依赖是在您的output$plot 中。这就是为什么您的观察事件不会对input$periods 的更改做出反应。我认为您的根本问题是您的代码（此处和您的其他相关帖子中）将 input、manipulation 和 presentation 混为一谈。这从来都不是一个好主意。我会让你的矩阵reactives。然后，您触发对输入的更新以响应矩阵reactives 的更改。但是递归将是一个问题，因为您还希望触发对您的reactives 的更改以响应对您的input 的更改。但这是可以做到的。
在observeEvent(input$matrix2, {...}) 你有isolate(updateMatrixInput(session, inputId = "matrix3", value = input$matrix2))。也许 ID 应该是matrix2。
嗨 YBS，引用的代码行实际上适用于下游 matrix2 值到 matrix3。我尝试了您的更改以及注释掉下游的行和矩阵值不再有效。我试图弄清楚如何分解“上游”矩阵值，以便只有所需的上游矩阵值被下游。然后我可以开始下游 input$periods，创建所需的依赖项。我不知道这是否比使用确实有效的 renderUI 更容易理解。
发布上面修改后的代码。

标签： r shiny shiny-reactivity

【解决方案1】：

上面作为对原始问题的编辑发布的“已解决的代码”解决了此问题（原始问题显示在“已解决的代码”下方）。基本上，上游矩阵值在observeEvent 中解析，然后在同一observeEvent 中向下传递到适用的矩阵。关于提出的问题：“这种非renderUI 方法比...中显示的renderUI 方法更好吗？”我的答案是肯定的——删除renderUI 会给你留下很多更干净，更容易遵循代码。我只需要在observeEvent 中嵌入矩阵解析代码就更舒服了。我也明白，如果没有 renderUI，代码会运行得更快，因为对象只是被编辑，而不是像 renderUI 那样完全重新渲染。

【讨论】：