r - 使用 renderUI 显示所有对象

我正在开发一个具有动态渲染的 shiny 应用程序。当用户取消选中该框时,他必须有一个带有 8 个 WellPanel 的输出,而当该框被选中时,他必须有两个 WellPanel。我使用函数 renderUI 生成输出,但是当未选中该框时,我只有 4 个 wellPanel 而不是 8 个。这就是我所做的:

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)


body <- dashboardBody(

  tabItems(
    
    tabItem(tabName = "menutab1",
            
            checkboxInput(inputId = "my_id", "check the box", value = TRUE),

            ####### renderUI #####
            uiOutput("results")
            
    )
  )
  
  
)

ui <- dashboardPage(
  
  title = "test",
  options = list(sidebarExpandOnHover = TRUE),
  header = dashboardHeader(disable = FALSE),
  sidebar = dashboardSidebar(
    minified = TRUE, collapsed = TRUE,
    sidebarMenu(id="mymenu",
                
                menuItem("first", tabName =  "tab1", icon = icon("fas fa-acorn"),
                         menuSubItem('menu 1',
                                     tabName = 'menutab1',
                                     icon = icon('fas fa-hand-point-right'))
                )
                
                
    )
  ),
  
  body
  
)


############# SERVER ############
server <- function(input, output) {
  
  output$results <- renderUI({
    
    if(input$my_id){
      # object 1
      fluidRow(
        column(6,
               wellPanel(
                 h1("A")
               ),
               br(),
               wellPanel(
                 h1("B")
               )
        )
      )
      
    } else {
      
      # object 2 : doesnt show, why ?
      fluidRow(
        column(6,
               wellPanel(
                 h1("C")
               ),
               br(),
               wellPanel(
                 h1("D")
               )
        ),
        column(6,
               wellPanel(
                 h1("E")
               ),
               br(),
               wellPanel(
                 h1("F")
               )
        )
      )
      
      # object 3 : I only got this
      fluidRow(
        column(6,
               wellPanel(
                 h1("H")
               ),
               br(),
               wellPanel(
                 h1("I")
               )
        ),
        column(6,
               wellPanel(
                 h1("J")
               ),
               br(),
               wellPanel(
                 h1("K")
               )
        )
      )
      
    }

  })

}


############# RUN #############
shinyApp(ui = ui, server = server)

我们怎样才能解决这个问题?

一些帮助将不胜感激

回答1

上面代码的问题是,只返回 else 语句的最后一个对象。您可以将两个 fluidRows 包装在 tagList 中以获得所需的输出。

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)

body <- dashboardBody(tabItems(tabItem(
  tabName = "menutab1",
  checkboxInput(inputId = "my_id", "check the box", value = TRUE),
  uiOutput("results")
)))

ui <- dashboardPage(
  title = "test",
  options = list(sidebarExpandOnHover = TRUE),
  header = dashboardHeader(disable = FALSE),
  sidebar = dashboardSidebar(
    minified = TRUE,
    collapsed = TRUE,
    sidebarMenu(
      id = "mymenu",
      menuItem(
        "first",
        tabName =  "tab1",
        icon = icon("fas fa-acorn"),
        menuSubItem(
          'menu 1',
          tabName = 'menutab1',
          icon = icon('fas fa-hand-point-right')
        )
      )
    )
  ),
  body
)

server <- function(input, output) {
  output$results <- renderUI({
    if (input$my_id) {
      fluidRow(column(6,
                      wellPanel(h1("A")),
                      br(),
                      wellPanel(h1("B"))
      )
      )
    } else {
      tagList(
        fluidRow(
          column(6,
                 wellPanel(h1("C")),
                 br(),
                 wellPanel(h1("D"))),
          column(6,
                 wellPanel(h1("E")),
                 br(),
                 wellPanel(h1("F")))
        ),
        fluidRow(
          column(6,
                 wellPanel(h1("H")),
                 br(),
                 wellPanel(h1("I"))),
          column(6,
                 wellPanel(h1("J")),
                 br(),
                 wellPanel(h1("K")))
        )
      )
    }
  })
}

shinyApp(ui = ui, server = server)

相似文章