Question

我有一个有车的标签，根据我选择哪辆车的年份列表会出现（这也取决于我选择的车型）

现在我已经创建了这个依赖

但我也有一个滑块用于创建尽可能多的汽车标签和相关的年份标签

所有标签都会响应滑块。

但是我想成对创建它们。所以如果我在滑块选择中从2增加到3。我想创建3个汽车标签以及3个相关的年份标签

因此，一对标签（汽车和年份）一起创建，它们应该在彼此之下。我希望它像

一样

cars:
Year:

cars:
Year:

现在是

cars:
cars:
Year:
Year:

非常感谢任何帮助

library(shiny)
library(shinydashboard)    

ui <- dashboardPage(dashboardHeader(),

                    dashboardSidebar(
                      sliderInput("integer", "numbtabs:",min=1,max=10,value=2),


             menuItem(uiOutput("select_inputs"),
             uiOutput("select_inputs2"))    

                    ),dashboardBody( fluidRow(box()       )))

server <- function(input, output){

  observeEvent(input$integer, output$select_inputs <- renderUI({
    lapply(1:input$integer, function(i){
      selectInput(paste0('cars',    i),
                 "cars:",list("Select"="","a"="mazda","b"="ford"))


    })

  })



  )

  observeEvent(input$integer, output$select_inputs2 <- renderUI({
    lapply(1:input$integer, function(i){
       if(input[[paste0('cars', i)]]=="mazda"){a=list("Select"="","201amazda1"="FYmazda11", "201aaa2"="FY12")}
else if(input[[paste0('cars', i)]]=="ford"){a=list("Select"="","2001"="FYFORd11", "201FORD2"="FY1200")}
      selectInput(paste0('year1',    i),"year:",a)

    })


  }))

}

shinyApp(ui = ui, server = server)

Answer 1

以下是使用shiny modules的解决方案。基本上，您首先为单个车辆/年选择创建一个模块，然后多次包含它。

该模块由一个“服务器部分”和一个“ui-part”组成，显示两个下拉菜单。根据您的示例，第二个下拉菜单的选项取决于第一个下拉菜单中的选择。

carYearUi <- function(id) {
  ns <- NS(id)

  wellPanel(
    selectInput( 
      ns('cars'), "cars:", list("Select" = "", "a" = "mazda", "b" = "ford")),
    uiOutput(ns('year'))
  )
}

carYearServer <- function(input, output, session){
  ns <- session$ns

  output$year = renderUI({
    if(input$cars == "mazda")
      choices <- list("Select" = "","201amazda1" = "FYmazda11", "201aaa2" = "FY12")
    else
      choices <- list("Select" = "", "2001" = "FYFORd11", "201FORD2" = "FY1200")
    selectInput(ns('year'), "year:", choices)
  })
}

应用的其余部分会创建一个滑块，并使用uiOutput创建动态数量的carYear个实例。

library(shiny)

ui <- fluidPage(
  sliderInput("slider","how much cars?", 1, 8, 1, width = "100%" ),
  uiOutput("selectors")
)

server <- function(input, output, session){
  # setup the servers for the modules
  for(i in 1:8)
    callModule(carYearServer, i)

  # create dynamic ui which shows all the dropdown boxes
  output$selectors <- renderUI({
    lapply(1:input$slider, carYearUi)
  })
}

shinyApp(ui, server)

下拉菜单的选择可以通过ID 1-cars，1-year，2-cars，...，8-year获得。或者，您也可以使用NS功能获取ID：NS(1, "cars")，...，NS(8, "year")

关于跟进问题

以下是reactiveValues函数中使用carYearServer的解决方案。我还需要将一些代码从carYearUi移到carYearServer。请注意，模块本身负责存储，因此无需更改代码的其余部分（ui <- ...，server <- ...）

library(shiny)

carYearUi <- function(id) {
  ns <- NS(id)
  wellPanel(
    uiOutput(ns('cars')),
    uiOutput(ns('year'))
  )
}

carYearServer <- function(input, output, session){
  ns <- session$ns
  storage <- reactiveValues()      ## initialize
  output$year = renderUI({
    if(identical(input$cars, "mazda"))
      choices <- list("Select" = "","201amazda1" = "FYmazda11", "201aaa2" = "FY12")
    else
      choices <- list("Select" = "", "2001" = "FYFORd11", "201FORD2" = "FY1200")
    selectInput(
      ns('year'), "year:", choices, 
      selected = storage$year     ## get 
    )
  })
  output$cars <- renderUI({
    selectInput( 
      ns('cars'), "cars:", list("Select" = "", "a" = "mazda", "b" = "ford"),
      selected = storage$car       ## get
    )
  })
  observe({
    storage$year <- input$year     ## set
    storage$car <- input$cars      ## set
  })
}

或者，您可以使用shiny::updateSelectInput或outputOptions(..., suspendWhenHidden = FALSE)

依赖于其他选项卡的闪亮动态选项卡如何同时创建它们

1 个答案:

关于跟进问题