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
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)