Hierarchical sidebarLayout() using the selectInput() variables information - r

Question

I'd like to create a dynamic and hierarchical sidebarLayout using the selectInput
variables information. I have a pet information data frame (myds) and for example, I choose dog option in "selectedvariable1" pet, then in "selectedvariable3" the options need to be "collie" or "pit-bull", not "birman" or "bobtail" because the option in "selectedvariable1"is a dog, not a cat.
In my example:
# Packages
library(shiny)
# Create my data set
pet<-c("dog","dog","cat","cat")
fur<-c("long","short","long","short")
race<-c("collie","pit-bull","birman","bobtail")
sweetness<-c("high","medium","high","medium")
myds<-data.frame(pet,fur,race,sweetness)
# Create the pet shiny dash
ui <- fluidPage(
titlePanel(title="My Pet Dashboard"),
sidebarLayout(
sidebarPanel(
uiOutput("selectedvariable1"),
uiOutput("selectedvariable2"),
uiOutput("selectedvariable3"),
uiOutput("selectedvariable4")
),
mainPanel(
textOutput("idSaida")
)
)
)
server <- function(input, output,session){
currentvariable1 <- reactive({input$selectedvariable1})
currentvariable2 <- reactive({input$selectedvariable2})
currentvariable3 <- reactive({input$selectedvariable3})
currentvariable4 <- reactive({input$selectedvariable4})
output$selectedvariable1 <- renderUI({
selectInput("selectedvariable1",
label = "Pet type",
choices = unique(myds$pet),
selected = TRUE )
})
data2 <- reactive({
data2 <- subset(myds, fur %in% unique(currentvariable2()))
})
output$selectedvariable2 <- renderUI({
data2 <- subset(myds, pet %in% unique(currentvariable1()))
selectInput("selectedvariable2",
label = "Fur style",
choices = unique(data2$fur),
selected = TRUE )
})
data3 <- reactive({
data3 <- subset(data2, fur %in% unique(currentvariable2()))
})
output$selectedvariable3 <- renderUI({
selectInput("selectedvariable3",
label = "Race name",
choices = unique(data3$race),
selected = TRUE )
})
data4 <- reactive({
data4 <- subset(data2, fur %in% unique(currentvariable3()))
})
output$selectedvariable4 <- renderUI({
selectInput("selectedvariable4",
label = "Sweetness behaviour",
choices = unique(data4$sweetness),
selected = TRUE )
})
}
shinyApp(ui, server)
##
Please, anyone can help me with this question?

Answer 1

Try this
server <- function(input, output,session){
# currentvariable1 <- reactive({input$selectedvariable1})
# currentvariable2 <- reactive({input$selectedvariable2})
# currentvariable3 <- reactive({input$selectedvariable3})
# currentvariable4 <- reactive({input$selectedvariable4})
output$selectedvariable1 <- renderUI({
selectInput("selectedvariable1",
label = "Pet type",
choices = unique(myds$pet),
selected = TRUE )
})
data2 <- reactive({
req(input$selectedvariable1)
data2 <- subset(myds, pet %in% input$selectedvariable1)
})
output$selectedvariable2 <- renderUI({
req(data2())
#data2 <- subset(data2(), pet %in% unique(currentvariable1()))
selectInput("selectedvariable2",
label = "Fur style",
choices = unique(data2()$fur),
selected = TRUE )
})
data3 <- reactive({
req(input$selectedvariable2,data2())
data3 <- subset(data2(), fur %in% input$selectedvariable2)
})
output$selectedvariable3 <- renderUI({
req(data2())
selectInput("selectedvariable3",
label = "Race name",
choices = unique(data2()$race), ## use data3() instead of data2(), if you wish to subset from data3()
selected = TRUE )
})
data4 <- reactive({
req(input$selectedvariable3,data2())
data4 <- subset(data2(), race %in% input$selectedvariable3)
})
output$selectedvariable4 <- renderUI({
req(data4())
selectInput("selectedvariable4",
label = "Sweetness behaviour",
choices = data4()$sweetness,
selected = TRUE )
})
}
shinyApp(ui, server)

Answer 2

Something like this should work, add this to server function and adapt to your code:
observeEvent(input$selectedvariable1,{
if (input$selectedvariable1=="dog") {
updateSelectInput("selectedvariable3", choices=c("collie","pit-bull"))
}
})