How to pass shinytree values to drop down input in shiny

Question

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

Answer 1

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)