如何在 R Shiny 中使用条件面板仅隐藏和显示用户输入，同时仍允许运行底层计算？

Question

在下面的 R Shiny 代码中，我使用

conditionalPanel()

显示/隐藏“子 X/Y 表”中的可选用户输入，以将其他变量包含到数学运算中。我只希望

conditionalPanel()

隐藏（并显示）额外的用户输入到在

sidebarPanel()

中呈现的子 X/Y 表中，同时允许计算运行，就像这些用户输入没有隐藏一样，从而呈现在

mainPanel()

输出表称为

mainTbl

，无论是否检查

checkboxInput()

。这怎么办？

这些图片解释了。第一个图像是首次调用应用程序时出现的图像：

此图像显示了选中

checkboxInput()

时呈现的内容。我希望在首次调用应用程序时，即使未选中

mainPanel()

，也能呈现

checkboxInput()

的以下输出表：

代码：

library(shiny)
library(rhandsontable)

extraFun <- function(input_df, time_win, col_name) {
  df <- setNames(data.frame(rep(NA, time_win)), col_name)
  df[,col_name] <- 
    ifelse(seq_along(df[,1])%in%input_df[,1],input_df[match(seq_along(df[,1]),input_df[,1]),2],0)
  return(df)
}

ui <- fluidPage(
  sidebarPanel(
    h5(strong("Variable (Y) over window (W):")),
    rHandsontableOutput("parentTbl"), 
    checkboxInput("showCurves", HTML("<b>Add curves</b>"), FALSE),  
    conditionalPanel(
      condition = "input.showCurves == true",
      uiOutput("childTbl")
    )
  ),
  mainPanel(tableOutput("mainTbl"))
)

server <- function(input, output, session) {
  parentVars  <- lapply(1:2, function(i) { reactiveValues(data = 2) })
  grpInputs   <- reactiveValues(tables = list())
  plus        <- reactive(extraFun(grpInputs$tbl[["A"]],10,"A"))
  minus       <- reactive(extraFun(grpInputs$tbl[["B"]],10,"B"))
  
  output$parentTbl <- renderRHandsontable({
    rhandsontable(
      data.frame(Inputs = sapply(parentVars, function(x) x$data)),
      rowHeaders = c("A","B")
    )
  })
  
  observeEvent(input$parentTbl, {
    newValues <- hot_to_r(input$parentTbl)$Inputs
    for (i in 1:2) {parentVars[[i]]$data <- newValues[i]}
  })
 
  # Below builds child X/Y tables #
  lapply(1:2, function(i) {
    varInputId <- c("A","B")[i]
    output[[varInputId]] <- renderRHandsontable({
      df <- data.frame(X = 1, Y = parentVars[[i]]$data)
      rhandsontable(df, contextMenu = TRUE, rowHeaders = FALSE) 
    })
  })
  
  output$childTbl <- renderUI({
    lapply(1:2, function(i) {
      varInputId <- c("A","B")[i]
      list(
        h5(strong(paste("Adjust ", varInputId, " (Y) at time X:"))),
        rHandsontableOutput(varInputId)
      )
    })
  })
  
  observe({
    lapply(1:2, function(i) {
      varInputId <- c("A","B")[i]
      if (!is.null(input[[varInputId]])) {
        grpInputs$tbl[[i]] <- hot_to_r(input[[varInputId]])
        names(grpInputs$tbl)[i] <- varInputId
      }
    })
  })
  
  amCrs <- reactive({
    balances <- cumprod(c(1, 1+plus()[1:10,1]-minus()[1:10,1]))
    b <- head(balances, -1)
    result <- data.frame(
      Begin=b,Add=b*plus()[1:10,1],Subtract=b*minus()[1:10,1],End=balances[-1]
    )
  })
  
  output$mainTbl <- renderTable({
    req(length(grpInputs$tbl) > 0)
    amCrs()
  })
  
}

shinyApp(ui, server)

Answer 1

在此添加

outputOptions(output, varInputId, suspendWhenHidden = FALSE)

：

  lapply(1:2, function(i) {
    varInputId <- c("A","B")[i]
    output[[varInputId]] <- renderRHandsontable({
      df <- data.frame(X = 1, Y = parentVars[[i]]$data)
      rhandsontable(df, contextMenu = TRUE, rowHeaders = FALSE) 
    })
    outputOptions(output, varInputId, suspendWhenHidden = FALSE)
  })