0

以下のように、Rshinyで階層的なドロップダウンリストを持つ、shinyでドロップダウン入力を作成しようとしています:

Rshinyの階層ドロップダウンリスト

今のところ、リスト全体を表示できる Shinytree を作成できますが、Shinytree ではなくドロップダウンでリストを表示したいと考えています。

以下は私のコードです：

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

4

1 に答える 1

0

昨日、 ComboTreeライブラリの Shiny バインディングを行いました。それは機能しますが、これは素晴らしいことではありません。

wwwサブフォルダーに配置するファイルcombowTreeBinding.js :

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 アプリ (ファイルstyle.cssとomboTreePlugin.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)

ここに画像の説明を入力

于 2020-02-20T08:12:42.723 に答える