可以在 R Shiny 中嵌套 outputUI 和 renderUI 吗？

Question

我试图将条件面板从ui 部分移动到server 部分，方法是将条件面板包装在renderUI 函数中。我这样做是为了消除在设置条件面板之前调用应用程序时其他项目的闪烁。我在一个更简单的应用程序上尝试了这个，这就是这个技巧。但是，当我在此处发布的 MWE 代码上尝试它时，我收到一条错误消息。这个 MWE 更复杂的是，我移动到 renderUI 的条件面板之一已经调用了另一个 renderUI。我认为可以嵌套outputUI/renderUI。有什么办法可以做到吗？

以下是 2 个代码示例。第一个 MWE 可以正常工作（除了在设置条件面板之前闪烁其他内容 - 移至 renderUI 应该可以解决）。下面的第二组代码反映了我尝试使用renderUI 将条件面板从ui 移动到server。

工作 MWE：

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

matrix1.input <- function(x){
  matrixInput(
    x,
    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")}

vector.base <- function(x,y){
  a <- rep(y,x)                                     
  b <- seq(1:x)                                     
  c <- data.frame(x = b, y = a)                     
  return(c)}

ui <- 
  pageWithSidebar(
    headerPanel("Model"),
    sidebarPanel(
      conditionalPanel(condition="input.tabselected==1"),
      conditionalPanel(
          condition="input.tabselected==2",
          sliderInput('periods','Input periods:',min=1,max=120,value=60),
          matrix1.input("base_input"),
          useShinyjs(),
          actionButton('showPerfVectorBtn','Show'), 
          actionButton('hidePerfVectorBtn','Hide'),
          actionButton('resetPerfVectorBtn','Reset'),
          hidden(uiOutput("Vectors"))
      ) # close conditional panel
    ), # close sidebar panel
    mainPanel(
      tabsetPanel(
        tabPanel("About",value=1),
        tabPanel("Dynamic",value=2,plotOutput("graph1")), 
        id = "tabselected"
      ) # close tabset panel
    ) # close main panel
  ) # close page with sidebar

server <- function(input,output,session)({
  
  periods        <-  reactive(input$periods)
  base_input     <-  reactive(input$base_input)
  vector_input   <-  reactive(input$vector_input)

  observeEvent(input$periods|input$base_input,{
    updateMatrixInput(session,"vector_input", 
      value=matrix(c(input$periods,input$base_input[1,1]),1,2))})
  
  output$Vectors <- renderUI({
    input$resetPerfVectorBtn
    tagList(matrix1.input("Plot"))
    }) # close render UI
  
  observeEvent(input$showPerfVectorBtn, {shinyjs::show("Vectors")})
  observeEvent(input$hidePerfVectorBtn, {shinyjs::hide("Vectors")})
 
  output$graph1 <- renderPlot(
    if(input$showPerfVectorBtn == 0)
      plot(vector.base(periods(),input$base_input[1,1]))
    else plot(vector.base(periods(),input$base_input[1,1])))
}) # close server

shinyApp(ui, server)

我尝试使用renderUI 将条件面板从ui 移动到server 的崩溃代码（为简洁起见，下面未显示定义的函数vector.base，它们显示在上面的MWE 代码中） ：

ui <- 
  pageWithSidebar(
    headerPanel("Model"),
    sidebarPanel(
      uiOutput("Panels")
    ), # close sidebar panel
    mainPanel(
      tabsetPanel(
        tabPanel("About",value=1),
        tabPanel("Dynamic",value=2,plotOutput("graph1")), 
        id = "tabselected"
      ) # close tabset panel
    ) # close main panel
  ) # close page with sidebar

server <- function(input,output,session)({
  
  periods        <-  reactive(input$periods)
  base_input     <-  reactive(input$base_input)
  vector_input   <-  reactive(input$vector_input)
  
  observeEvent(input$periods|input$base_input,{
    updateMatrixInput(session,"vector_input", 
                      value=matrix(c(input$periods,input$base_input[1,1]),1,2))})
  
  output$Panels <- renderUI({
    conditionalPanel(condition="input.tabselected==1")
    conditionalPanel(
      condition="input.tabselected==2",
      sliderInput('periods','Input periods:',min=1,max=120,value=60),
      matrix1.input("base_input"),
      useShinyjs(),
      actionButton('showPerfVectorBtn','Show'), 
      actionButton('hidePerfVectorBtn','Hide'),
      actionButton('resetPerfVectorBtn','Reset'),
      hidden(uiOutput("Vectors"))
    ) # close seconds conditional panel
  })

  output$Vectors <- renderUI({
    input$resetPerfVectorBtn
    tagList(matrix1.input("Plot"))
  }) # close render UI
  
  observeEvent(input$showPerfVectorBtn, {shinyjs::show("Vectors")})
  observeEvent(input$hidePerfVectorBtn, {shinyjs::hide("Vectors")})
  
  output$graph1 <- renderPlot(
    if(input$showPerfVectorBtn == 0)
      plot(vector.base(periods(),input$base_input[1,1]))
    else plot(vector.base(periods(),input$base_input[1,1])))
}) # close server

shinyApp(ui, server)

Answer 1

是的，可以在 R 中嵌套 outputUI/renderUI。下面已解决的代码执行此操作。看看output$Vectors 是如何嵌套在output$Panels 中的，两者都在server 部分中使用renderUI。

所有这些代码移动的目的是消除第一次调用应用程序时所有ui 项目的快速闪烁，使其显得草率、错误、不专业。将条件面板从ui 移动到server 部分，在代码的ui 部分中使用outputUI，在server 部分中使用renderUI，消除了所有@987654334 的闪烁@item 首次调用应用程序时。

以下是最终解决的代码。上面的“崩溃代码”不起作用，因为server 下的renderUI 部分中的条件面板需要包装在tagList 中，如下所示。一个偶然的疏忽。此外，上面的崩溃代码也崩溃了，因为updateMatrixInput 的observeEvent 也需要包装在renderUI 中（关于最后一项，我不确定为什么会这样 - 我通过试用和错误和预感。我希望这不会导致另一个问题 - 通常当我实施我不 100% 理解的“修复”时会发生什么。

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

matrix1.input <- function(x){
  matrixInput(
    x,
    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")}

vector.base <- function(x,y){
  a <- rep(y,x)                                     
  b <- seq(1:x)                                     
  c <- data.frame(x = b, y = a)                     
  return(c)}

ui <- 
  pageWithSidebar(
    headerPanel("Model"),
    sidebarPanel(
      uiOutput("Panels")
    ), # close sidebar panel
    mainPanel(
      tabsetPanel(
        tabPanel("About",value=1),
        tabPanel("Dynamic",value=2,plotOutput("graph1")), 
        id = "tabselected"
      ) # close tabset panel
    ) # close main panel
  ) # close page with sidebar

server <- function(input,output,session)({
  
  periods        <-  reactive(input$periods)
  base_input     <-  reactive(input$base_input)
  vector_input   <-  reactive(input$vector_input)

  output$Panels <- renderUI({
    tagList(
      conditionalPanel(condition="input.tabselected==1"),
      conditionalPanel(
        condition="input.tabselected==2",
        sliderInput('periods','Input periods:',min=1,max=120,value=60),
        matrix1.input("base_input"),
        useShinyjs(),
        actionButton('showPerfVectorBtn','Show'), 
        actionButton('hidePerfVectorBtn','Hide'),
        actionButton('resetPerfVectorBtn','Reset'),
        hidden(uiOutput("Vectors")),
      ) # close conditional panel
    ) # close tagList
  }) # close renderUI
  
  output$Vectors <- renderUI({
    input$resetPerfVectorBtn
    tagList(matrix1.input("Plot"))
  }) # close render UI
 
  # run observeEvent in renderUI
  renderUI({ 
    observeEvent(input$periods|input$base_input,{
      updateMatrixInput(session,"vector_input",
                        value=matrix(c(input$periods,input$base_input[1,1]),1,2))})
  }) # close renderUI
    
  observeEvent(input$showPerfVectorBtn, {shinyjs::show("Vectors")})
  observeEvent(input$hidePerfVectorBtn, {shinyjs::hide("Vectors")})
  
  output$graph1 <- renderPlot(
    if(input$showPerfVectorBtn == 0)
      plot(vector.base(periods(),input$base_input[1,1]))
    else plot(vector.base(periods(),input$base_input[1,1])))
}) # close server

shinyApp(ui, server)