Можно ли вложить outputUI и renderUI в R Shiny?

Question

Я пытаюсь переместить условные панели из раздела ui в раздел server, поместив условные панели в функцию renderUI. Я делаю это для того, чтобы исключить мигание других элементов при вызове приложения перед размещением на условных панелях. Я попробовал это в более простом приложении, и это делает этот трюк. Однако, когда я пробую это с кодом MWE, размещенным здесь, я получаю сообщение об ошибке. Что еще сложнее в этом MWE, так это то, что одна из условных панелей, которую я перемещаю на renderUI, уже вызывает другую renderUI. Я предположил, что можно вложить outputUI/renderUI. Есть ли способ заставить это работать?

Ниже приведены 2 примера кода. Первый MWE работает как надо (за исключением перепрошивки других вещей до установки на условную панель - что должно разрешиться переходом на renderUI). Второй набор кода ниже отражает мою попытку переместить условные панели с ui на server с помощью renderUI.

.

Рабочий 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)

Код сбоя, когда я пытаюсь переместить условные панели из ui в server с помощью renderUI (определенные функции matrix1.input и 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)

Можно ли вложить outputUI и renderUI в R Shiny?

Ответы (1)