javascript - 如何传递闪亮树值以在闪亮中下拉输入

Question

我正在尝试在 Shiny 中创建下拉输入，该输入在 R Shiny 中具有分层下拉列表，如下所示：

R闪亮中的分层下拉列表

现在我可以创建一个闪亮树，我们可以在其中显示整个列表，但我想在下拉列表中显示列表，而不是闪亮树。

下面是我的代码：

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)

我正在以这种方式寻找输入：Custom-Dropdown

标签： javascriptrshinyhierarchicalshinytree

Answer 1

我昨天为ComboTree库做了一个闪亮的绑定。它有效，但这并不好。

文件comboTreeBinding.js放入www子文件夹：

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

闪亮的应用程序（将文件style.css和comboTreePlugin.js放在www子文件夹中）：

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)