r - 多级下拉悬停 R Shiny

Question

我正在寻找 R 中多级下拉列表的解决方案

我已经浏览了这里的大部分软件包，https://github.com/nanxstats/awesome-shiny-extensions
无法在任何可用的软件包中找到解决方案
一个紧密的解决方案是

              # selectInput("state", "Choose a word:", width = 400,
                       #             list(`Building` = list("Apartment"="ap", "Bank"="bk", "Hospital"="hp"),
                       #                  `Nature` = list("Bank"="bk1", "River"="rv", "Orange"="or"),
                       #                  `Color` = list("Blue"="bl", "Orange"="or1", "Red"="rd"))

除了当列表很长时很难管理
附言问题和图片来自 https://github.com/rstudio/shiny/issues/2729

Answer 1

我刚刚做了一个包裹。它使用 JavaScript 库 jquery-contextMenu .要安装它:

remotes::install_github("stla/NestedMenu")

请注意，这只是目前的草稿。

用法示例:

library(NestedMenu)
library(shiny)

cities <- list(
  europe = list(
    name = "Europe",
    items = list(
      france = list(
        name = "France",
        items = list(
          paris = list(name = "Paris"),
          lyon = list(name = "Lyon")
        )
      ),
      italy = list(
        name = "Italy",
        items = list(
          roma = list(name = "Roma"),
          milano = list(name = "Milano")
        )
      )
    )
  ),
  america = list(
    name = "America",
    items = list(
      namerica = list(
        name = "North America",
        items = list(
          usa = list(
            name = "USA",
            items = list(
              chicago = list(name = "Chicago"),
              newyork = list(name = "New York")
            )
          ),
          canada = list(
            name = "Canada",
            items = list(
              ottawa = list(name = "Ottawa"),
              toronto = list(name = "Toronto")
            )
          )
        )
      ),
      samerica = list(
        name = "South America",
        items = list(
          brazil = list(
            name = "Brazil",
            items = list(
              brasilia = list(name = "Brasilia"),
              saopolo = list(name = "Sâo Polo")
            )
          ),
          mexico = list(
            name = "Mexico",
            items = list(
              mexicocity = list(name = "Mexico City"),
              tijuana = list(name = "Tijuana")
            )
          )
        )
      )
    )
  )
)

ui <- fluidPage(
  br(),
  NestedMenuOutput("menu", height = "auto"),
  br(),
  verbatimTextOutput("clicked")
)

server <- function(input, output, session){

  output[["menu"]] <- renderNestedMenu({
    NestedMenu(
      "Cities", items = cities
    )
  })

  output[["clicked"]] <- renderPrint({
    input[["menu"]]
  })

}

shinyApp(ui, server)