r - 根据同一模块中的输入在 Shiny 模块中渲染条件 UI 组件

Question

我有一个有条件地在同一个模块中呈现 ui 组件的模块。条件也包含在同一模块中。此条件渲染不起作用。可能与范围界定有关。我在with中添加ns <- session$ns和包装了输入和输出。这是一个最小的例子。我错过了什么？除了代码更正之外，非常感谢您进行一些详细说明以更好地理解！renderUIns()

用户界面

#Define header
header <- dashboardHeader(title = "Demo")

#Define sidebar
sidebar <- dashboardSidebar(sidebarMenu(menuItem("Menu Item", tabName = "menu_item")))

#Define body
body <- dashboardBody(tabItems(tabItem(
    tabName = "menu_item",
    tabBox(
        width = 12,
        title = "",
        id = "tabset1",
        tabPanel(title = "Panel1",
                 panel1_ui("panel1")),
        tabPanel(title = "Panel 2")
    )
)))

#Create ui
ui <- dashboardPage(header, sidebar, body)

服务器.R

# Define server logic
server <- function(input, output, session) {
  
  #Server code for module
  callModule(panel1_server, "panel1")
  
}

模块.R

#Define ui
panel1_ui <- function(id) {
  ns <- NS(id)
  
  tagList(fluidRow(
    #Input box
    box(
      title = "Input box",
      status = "primary",
      solidHeader = TRUE,
      width = 4,
      
      sliderInput(
        inputId = "amount",
        label = "Amount:",
        min = 0,
        max = 5,
        value = 0,
        step = 1
      )
    ),
    
    conditionalPanel("input.amount > 0",
                     uiOutput(outputId = "output1"))
  ))
}

#Define server
panel1_server <- function(input, output, session) {
  ns <- session$ns
  
  fluidRow(column(width = 4,
                  
                  output$output1 <- renderUI({
                    box(
                      title = "Output box",
                      status = "primary",
                      width = 4,
                      solidHeader = TRUE,
                      uiOutput(outputId = ns("output2"))
                    )
                  })))
  
  output$output2 <- renderUI({
    if (ns(input$amount) == 0) {
      
    }
    else {
      lapply(c(1:input$amount), function(i) {
        hr()
        list(tags$u(strong(paste("Input ", i))),
             br(),
             column(
               6,
               dateInput(
                 inputId = paste0("date_", i),
                 label = paste0("Date:"),
                 value = Sys.Date()
               )
             ),
             column(
               6,
               selectInput(
                 inputId = paste0("yes_no", i),
                 label = "Yes or No:",
                 choices = c("Yes", "No"),
                 selected = "No"
               )
             ))
      })
    }
  })
}

标签： rshinyshinydashboard

Answer 1

感谢@Limey 的建议，我能够分解问题并解决它。这是工作模块代码。我已经添加了一些更改的评论。

模块.R

#Define ui
panel1_ui <- function(id) {
  ns <- NS(id)
  
  tagList(fluidRow(
    #Input box
    box(
      title = "Input box",
      status = "primary",
      solidHeader = TRUE,
      width = 4,
      
      sliderInput(
        
        #Forgot to wrap amount in ns()
        inputId = ns("amount"), 
        label = "Amount:",
        min = 0,
        max = 5,
        value = 0,
        step = 1
      )
    ),
    
    #Removed conditionalPanel
    #Forgot to wrap output1 in ns()
    uiOutput(outputId = ns("output1")) 
  ))
}

#Define server
panel1_server <- function(input, output, session) {
  ns <- session$ns
  
  fluidRow(column(width = 4,
  
  output$output1 <- renderUI({
    
    #Removed ns() around input$amount
    #If condition is not true, render nothing
    #Otherwise, render box with content
    if (input$amount == 0) {}
    else {
      box(
        title = "Output box",
        status = "primary",
        width = 4,
        solidHeader = TRUE,
        
        #Removed ns() around input$amount
        lapply(c(1:input$amount), function(i) { 
        hr()
        list(tags$u(strong(paste("Input ", i))),
             br(),
             column(
               6,
               dateInput(
                 
                 #Forgot to wrap date_i in ns()
                 inputId = ns(paste0("date_", i)), 
                 label = paste0("Date:"),
                 value = Sys.Date()
               )
             ),
             column(
               6,
               selectInput(
                 
                 #Forgot to wrap yes_no_i in ns()
                 inputId = ns(paste0("yes_no", i)), 
                 label = "Yes or No:",
                 choices = c("Yes", "No"),
                 selected = "No"
               )
             ))
      }))
    }
  })
  ))
}