В R Shiny, как поддерживать цепочку реактивности, когда объект в цепочке скрыт от глаз?

#javascript #r #shiny #shiny-reactivity

Вопрос:

В приведенном ниже коде MWE вводимые пользователем данные в первую матрицу ( firstInput это имя пользовательской функции, вызывающей первую матрицу) передаются во вторую матрицу ( secondInput ), в которую пользователь может дополнительно ввести данные, и результаты secondInput передаются в выходной график. (Эта связь между 2 матрицами может показаться абсурдной, но в более полном коде, из которого она извлечена, входы во вторую матрицу проходят через дополнительные/интраполяции; в духе MWE я удалил эту функциональность).

При запуске этого вы можете видеть, что пользователь может нажать кнопку «Показать», чтобы увидеть эту 2-ю матрицу, поскольку эти входные данные являются необязательными.

Моя проблема — реактивность. В настоящее время в готовом виде, если пользователь вносит изменения в значение в первой матрице, не показывая вторую матрицу, то эти изменения не будут реактивно отражены на графике. Я бы хотел, чтобы данные проходили по цепочке реактивности, даже если 2-я матрица скрыта. Есть ли обходной путь, простой другой способ «освежевать этого кота»?

Код 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)
 

Комментарии:

1. Любопытный Хорхе, пожалуйста, посмотрите мою правку для альтернативного решения. Тот факт, что второй ввод занимает некоторое место в этом решении, может быть желательным.

Ответ №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")
  })
}