rshinyreactivevtree

Dynamic change in vtree within shiny: How to deselect


This is a follow-up question of this R Shiny: Vtree plot not rendering with Shiny

With this code I can manage to get reactive behaviour for the levels (level1 - level4) and also for the input$values (4,6,8). But how can I get to disable for example level2 (or any other). Or how can I manage to select input$values all or only 4 and 6? With my code so far all levels appear and only one value could be selected!

Here is a reproducible code:

library(shiny)
library(vtree)


# Define UI ----
ui <- pageWithSidebar(
  
  # App title ----
  headerPanel("Cyl vtree"),
  
  # Sidebar panel for inputs ----
  sidebarPanel(
    selectizeInput("level1", label = "Level1", choices = NULL, selected = NULL),
    selectizeInput("level2", label = "Level2", choices = NULL),
    selectizeInput("level3", label = "Level3", choices = NULL),
    selectizeInput("level4", label = "Level4", choices = NULL),
    selectizeInput("values", label= "Values", choices = NULL),
  ),
  
  # Main panel for displaying outputs ----
  mainPanel(
    vtreeOutput("VTREE")
    
  )
)

# Define server logic to plot ----
server <- function(input, output,session) {
  df <- reactiveVal(mtcars)
  vector <- c("cyl","vs", "am","gear")
  
  observe({
    # select only the party columns 1-4; 5 is the county column
    updateSelectizeInput(session, "level1", choices = colnames(df()[vector]), selected = NULL) 
    updateSelectizeInput(session, "level2", selected = NULL, choices = colnames(df()[vector])) 
    updateSelectizeInput(session, "level3", choices = colnames(df()[vector])) 
    updateSelectizeInput(session, "level4", choices = colnames(df()[vector])) 
    # Get counties without duplicates
    updateSelectizeInput(session, "values", choices = unique(df()$cyl))
  })
  
  output[["VTREE"]] <- renderVtree({
    vtree(df(), c(input$level1, input$level2, input$level3, input$level4),
          sameline = TRUE,
          follow=list(cyl=input$values),
          pngknit=FALSE,
          horiz=TRUE,height=450,width=850)
  })

}

shinyApp(ui, server)

Solution

  • As requested.

    library(shiny)
    library(vtree)
    
    
    # Define UI ----
    ui <- pageWithSidebar(
      
      # App title ----
      headerPanel("Cyl vtree"),
      
      # Sidebar panel for inputs ----
      sidebarPanel(
        selectizeInput("level1", label = "Level1", choices = NULL, selected = NULL),
        selectizeInput("level2", label = "Level2", choices = NULL),
        selectizeInput("level3", label = "Level3", choices = NULL),
        selectizeInput("level4", label = "Level4", choices = NULL),
        # This line is the only change from the original code
        selectizeInput("values", label= "Values", choices = NULL, multiple=TRUE),
      ),
      
      # Main panel for displaying outputs ----
      mainPanel(
        vtreeOutput("VTREE")
        
      )
    )
    
    # Define server logic to plot ----
    server <- function(input, output,session) {
      df <- reactiveVal(mtcars)
      vector <- c("cyl","vs", "am","gear")
      
      observe({
        # select only the party columns 1-4; 5 is the county column
        updateSelectizeInput(session, "level1", choices = colnames(df()[vector]), selected = NULL) 
        updateSelectizeInput(session, "level2", selected = NULL, choices = colnames(df()[vector])) 
        updateSelectizeInput(session, "level3", choices = colnames(df()[vector])) 
        updateSelectizeInput(session, "level4", choices = colnames(df()[vector])) 
        # Get counties without duplicates
        updateSelectizeInput(session, "values", choices = unique(df()$cyl))
      })
      
      output[["VTREE"]] <- renderVtree({
        vtree(df(), c(input$level1, input$level2, input$level3, input$level4),
              sameline = TRUE,
              follow=list(cyl=input$values),
              pngknit=FALSE,
              horiz=TRUE,height=450,width=850)
      })
      
    }
    
    shinyApp(ui, server)
    ```