I have a tab which has car and depending on which car I select a list of years will appear (which also depends on which car I selected)
Now I have already created this dependany
But I also have a slider for creating as many car tabs and related year tabs
All tabs respond to the slider.
However I want to create them in pairs. So If I increase from 2 to 3 in slider selection. I want to create 3 car tabs together with 3 related year tabs
So a pair of tabs (car and year) are created together and they should be under each other. I would like it to be as
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)
Here is a solution using shiny modules. Basically, you first create a module for a single cars/year selection and then include it several times.
The module consists of a "server-part" and an "ui-part" showing two dropdown menus. The choices of the second dropdown menu depend on the selection in the first one according to your example.
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)
})
}
The rest of the app creates a slider and uses uiOutput
to create a dynamic number of carYear
instances.
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)
The selections of the dropdown menus can be acessed through the IDs 1-cars
, 1-year
, 2-cars
, ..., 8-year
. Alternatively, you can also use the NS
function to aquire the IDs: NS(1, "cars")
, ..., NS(8, "year")
Here is a solution using reactiveValues
inside the carYearServer
function. I needed to move some code from the carYearUi
to carYearServer
as well. Note that the module itself takes care of the storage, so it is not necessary to change the rest of the code (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
})
}
Alternatively, you can use shiny::updateSelectInput
or outputOptions(..., suspendWhenHidden = FALSE)