javascriptrshinyhierarchicalshinytree

How to pass shinytree values to drop down input in shiny


I'm trying to create dropdown input in shiny which has hierarchical drop-down list in R shiny like below:

hierarchical drop-down list in R shiny

For now I'm able to create an shinytree where we can display the entire list, but I want display the list in dropdown instead of shinytree.

Below is my code:

library(shiny)

library(shinyTree)

# Define UI for application:

    ui <- {fluidPage(
            sidebarLayout(
              sidebarPanel(width = 3,
                 div(shinyTree("Tree",checkbox = TRUE)),
                 verbatimTextOutput("selected")
              ), 
              mainPanel(width = 9)
           )      
    )}

# Define server logic:
    server <- function(input, output, session){
  
       observe({
          df <- data.frame(
             child= c('a','b','c','d','e','f','g','h'), 
             parent = c('f','f','f','g','h','i','i','i'))
    
          tree <- FromDataFrameNetwork(df)
    
          filtered_value <- as.list(tree)
    
          filtered_value <- filtered_value[-1]
    
          output$Tree <- renderTree({ 
            filtered_value
          })
       })
    }

# Run the application 
    shinyApp(ui = ui, server = server)

I'm looking for input in this manner: Custom-Dropdown


Solution

  • I did a Shiny binding for the ComboTree library yesterday. It works but this is not fantastic.

    File comboTreeBinding.js to put in the www subfolder:

    var comboTreeBinding = new Shiny.InputBinding();
    
    $.extend(comboTreeBinding, {
      find: function (scope) {
        return $(scope).find(".comboTree");
      },
      getValue: function (el) {
        var value = el.value.split(", ");
        var empty = value.length === 1 && value[0] === "";
        return empty ? null : value;
      },
      setValue: function(el, value) {
        $(el).setSelection(value);
      },
      subscribe: function (el, callback) {
        $(el).on("change.comboTreeBinding", function (e) {
          callback();
        });
      },
      unsubscribe: function (el) {
        $(el).off(".comboTreeBinding");
      },
      initialize: function(el) {
            var $el = $(el);
            $el.comboTree({
          source: $el.data("choices"),
          isMultiple: $el.data("multiple"),
          cascadeSelect: $el.data("cascaded"),
          collapse: true
        });
      }
    });
    
    Shiny.inputBindings.register(comboTreeBinding);
    

    Shiny app (put the files style.css and comboTreePlugin.js in the www subfolder):

    library(shiny)
    library(jsonlite)
    
    comboTreeInput <- function(inputId, width = "30%", height = "100px", 
                               choices, multiple = TRUE, cascaded = TRUE){
      tags$div(style = sprintf("width: %s; height: %s;", width, height),
               tags$input(id = inputId, class = "comboTree", type = "text", 
                          placeholder = "Select",
                          `data-choices` = as.character(toJSON(choices, auto_unbox = TRUE)),
                          `data-multiple` = ifelse(multiple, "true", "false"), 
                          `data-cascaded` = ifelse(cascaded, "true", "false")
               )
      )
    }
    
    choices <- list(
      list(id = 1, title = "item1"),
      list(id = 2, title = "item2", 
           subs = list(
             list(id = 21, title = "item2-1"), 
             list(id = 22, title = "item2-2")
           )
      ), 
      list(id = 3, title = "item3",
           subs = list(
             list(id = 31, title = "item3-1", isSelectable = FALSE,
                  subs = list(
                    list(id = 311, title = "item3-1-1"),
                    list(id = 312, title = "item3-1-2")
                  )
             ),
             list(id = 32, title = "item3-2")
           )
      )
    )
    
    ui <- fluidPage(
      tags$head(
        tags$link(rel = "stylesheet", href = "style.css"),
        tags$script(src = "comboTreePlugin.js"),
        tags$script(src = "comboTreeBinding.js")
      ),
      br(),
      h3("You selected:"),
      verbatimTextOutput("selections"),
      br(),
      comboTreeInput("mycombotree", choices = choices)
    )
    
    server <- function(input, output, session){
    
      output[["selections"]] <- renderPrint({
        input[["mycombotree"]]
      })
    
    }
    
    shinyApp(ui, server)
    

    enter image description here