在 R Shiny 中，如何在 renderUI 部分嵌入一个 observeEvent 函数？答案

【问题标题】：In R shiny, how to embed an observeEvent function in the renderUI section?在 R Shiny 中，如何在 renderUI 部分嵌入一个 observeEvent 函数？
【发布时间】：2021-09-05 00:43:04
【问题描述】：

我在 Shiny 中使用 renderUI 时遇到问题。

在下面的 MWE 代码中，用户可以选择将滑块 (periods) 和第一个矩阵网格 (base_input) 的输入从其默认值更改为默认值（仅此矩阵的第一行，行“A”，为此 MWE 激活）。

用户还可以选择为“A”变量创建多变量向量，方法是单击“显示”按钮，并将值插入在同一个侧边栏中弹出的第二个矩阵 (vector_input)控制板。这工作正常。当一个人在滑块和 matrix1 的第一行/列中更改输入时（只要 matrix2 通过单击“显示”出现），matrix2 的第一行反应性地反映了这些变化，这就是它的预期工作方式。（请注意，要输入第二个矩阵，您必须先单击并输入右列，然后再输入左列 - 这是由于 shinyMatrix 中的一个小错误，我已修复但尚未实施）。

我的问题是：在单击触发 renderUI 的 SHOW 按钮之前，如何调整滑块和矩阵 1 的更改以反映在矩阵 2 中？

因此，如果用户在单击 SHOW 之前对 slider/matrix1 输入进行了任何更改，然后单击 SHOW，则对 slider/matrix1 的更改已经反映在 matrix2 中。

似乎下面将slider/matrix1链接到matrix2的observeEvent应该嵌入到renderUI部分中以使上述工作，但是当我尝试它时它不起作用。有什么解决办法吗？

另外，我不想单击“隐藏”按钮将值重置为该 matrix2 中的默认值。

我在下面发布了一些图片以使这一点更清楚。

以下是 MWE 代码：

library(shiny)
library(shinyMatrix)
library(shinyjs)

ui <- 
  pageWithSidebar(
    headerPanel("Model..."),
    sidebarPanel(
      conditionalPanel(condition="input.tabselected==2",
          sliderInput('periods','',min=1,max=120,value=60),
          matrixInput(
            "base_input",
            value = matrix(c(0.2), 4, 1, dimnames = list(c("A","B","C","D"),NULL)),
            rows = list(extend = FALSE,  names = TRUE),
            cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
            class = "numeric"),
                       
          h5(strong("Vectorize variables:")), # Adds a line of text
          # Action buttons to conditionally show/hide performance vectors:
          useShinyjs(),
          actionButton('showPerfVectorBtn','Show',style="width:9vw"), 
          actionButton('hidePerfVectorBtn','Hide',style="width:9vw"),
          uiOutput("Vectors")
      )), # close conditional and sidebar panels
    
  mainPanel(
    tabsetPanel(
      tabPanel("Dynamic", value=2,
               helpText("Dynamic B")),
        id = "tabselected"))
  ) # close page with sidebar

server <- function(input,output,session)({
  # --- Set reactive input variables
  periods       <- reactive(input$periods)
  base_input    <- reactive(input$base_input)
  vector_input  <- reactive(input$vector_input)
  
  # --- Link first row of vector input grids to base_input matrix
  observeEvent(input$periods|input$base_input,{
    updateMatrixInput(session,"vector_input", 
                      value=matrix(c(input$periods,input$base_input[1,1]),1,2, 
                                   dimnames=list(NULL, c("Y","Z")))
    ) # close update matrix
  }) # close observe event
  
  # --- Action buttons to conditionally show/hide performance vectors
  output$Vectors <- renderUI({
    req(input$showPerfVectorBtn)
    tagList(
        matrixInput(
          "vector_input",
          value = matrix(c(1,0.2),1,2,dimnames=list(NULL,c("Y","Z"))),
          rows = list(extend = TRUE,  names = FALSE),
          cols = list(extend = FALSE, names = TRUE, editableNames = FALSE),
          class = "numeric")
    ) # close tag list    
  }) # close render UI
  
  observeEvent(input$showPerfVectorBtn,{shinyjs::show("Vectors")})
  observeEvent(input$hidePerfVectorBtn,{shinyjs::hide("Vectors")})
  # --- Captures inputs as global variables
  observeEvent(periods(), {periods.R <<- periods()})
  observeEvent(base_input(), {base_input.R <<- base_input()})  
  observeEvent(vector_input(), {vector_input.R <<- vector_input()})
}) # close server section

shinyApp(ui, server)

【问题讨论】：

标签： r shiny

【解决方案1】：

解决方案比我想象的要简单得多。我又摆弄了一些，努力查看代码以确保我理解。

在matrixInput 函数中，在上面发布的 MWE 代码中 Server 部分的 renderUI 函数中，请参阅 value = matrix(c(1,0.2),1,2,dimnames=list(NULL,c("Y","Z"))) 行。

要使这项工作如上所述，只需更改该行中的矩阵定义 FROM c(1,0.2) TO c(input$periods,input$base_input[1,1])。那是我的疏忽。现在，随着对矩阵定义的这种更改，matrix2 值的第一行是完全反应式的，并且在所有使用场景中都链接到滑块（句点）和 matrix1 行 A（base_input）值。

【讨论】：