在 R Shiny 中，当链中的对象被隐藏时，如何维护反应链？

Posted 2023-03-24

【中文标题】在 R Shiny 中，当链中的对象被隐藏时，如何维护反应链？

【英文标题】：In R Shiny, how to maintain reactivity chain when an object in the chain is hidden from view?

【发布时间】：2021-11-18 12:46:19

【问题描述】：

在下面的 MWE 代码中，用户对第一个矩阵的输入（firstInput 是调用第一个矩阵的自定义函数的名称）被馈送到第二个矩阵（secondInput），用户可以选择输入该矩阵，secondInput 的结果被输入到输出图中。 （这两个矩阵之间的联系可能听起来很荒谬，但在从中提取的更完整的代码中，第二个矩阵的输入会经过额外/内插；本着 MWE 的精神，我删除了该功能。

在运行此程序时，您可以看到用户可以单击操作按钮“显示”来查看第二个矩阵，因为这些输入是可选的。

我的问题是反应性。目前草稿中，如果用户对第一个矩阵中的值进行更改而不显示第二个矩阵，则这些更改不会反应性地反映在绘图中。即使隐藏第二个矩阵，我也希望数据流过反应链。有没有一种解决方法，一种简单的其他方式来“给这只猫剥皮”？

MWE 代码：

rm(list = ls())

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

firstInput <- function(inputId)
  matrixInput(inputId, 
              value = matrix(c(5), 1, 1, dimnames = list(c("1st input"),NULL)),
              rows =  list(extend = FALSE, names = TRUE),
              cols =  list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric")

secondInput <- function(inputId,x)
  matrixInput(inputId, 
              value = matrix(c(x), 1, 1, dimnames = list(c("2nd input"),NULL)),
              rows =  list(extend = FALSE, names = TRUE),
              cols =  list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric")

ui <- fluidPage(
  titlePanel("Model"),
    sidebarLayout(
      sidebarPanel(
        uiOutput("panel"),
        hidden(uiOutput("secondInput")) # <<< remove "hidden" and reactivity is restored
      ),
      mainPanel(plotOutput("plot1"))
    )
  )

server <- function(input, output) 
  
  input1      <- reactive(input$input1)
  input2      <- reactive(input$input2)
  
  output$panel <- renderUI(
    tagList(
      useShinyjs(),
      firstInput("input1"),
      actionButton('show','Show 2nd inputs'),
      actionButton('hide','Hide 2nd inputs'))
  )
  
  output$secondInput <- renderUI(
    req(input1())
    secondInput("input2",input$input1[1,1])
  )
  
  output$plot1 <-renderPlot(
    req(input2())
    plot(rep(input2(),times=5))
  )
  
  observeEvent(input$show,shinyjs::show("secondInput"))
  observeEvent(input$hide,shinyjs::hide("secondInput"))


shinyApp(ui, server)

【问题讨论】：

好奇的 Jorge，请参阅我的编辑以获取替代解决方案。第二个输入在此解决方案中占用了一些空间这一事实可能是可取的。

【参考方案1】：

你可以这样做：

  output$secondInput <- renderUI(
    req(input1())
    secondInput("input2",input$input1[1,1])
  )
  outputOptions(output, "secondInput", suspendWhenHidden = FALSE)

---

编辑

另一种可能性是使用 CSS 属性 visibility: hidden 来隐藏第二个输入，而不是 shinyjs::hidden（它设置 CSS 属性 display: none）。有了这个属性，第二个输入是不可见的，但它占用了一些空间，它不是“严格隐藏”。

ui <- fluidPage(
  useShinyjs(),
  tags$head(
    tags$style(html(".Hidden visibility: hidden;"))
  ),
  titlePanel("Model"),
  sidebarLayout(
    sidebarPanel(
      uiOutput("panel"),
      div(
        id = "secondInputContainer",
        class = "Hidden",
        uiOutput("secondInput")
      ) 
    ),
    mainPanel(plotOutput("plot1"))
  )
)

server <- function(input, output) 
  
  # input1      <- reactive(input$input1) useless
  # input2      <- reactive(input$input2) useless
  
  output$panel <- renderUI(
    tagList(
      firstInput("input1"),
      actionButton('show', 'Show 2nd inputs'),
      actionButton('hide', 'Hide 2nd inputs'))
  )
  
  output$secondInput <- renderUI(
    req(input$input1)
    secondInput("input2", input$input1[1,1])
  )

  output$plot1 <-renderPlot(
    req(input$input2)
    plot(rep(input$input2, times=5))
  )
  
  observeEvent(input$show, 
    removeCssClass("secondInputContainer", "Hidden")
  )
  observeEvent(input$hide, 
    addCssClass("secondInputContainer", "Hidden")
  )