Multi level dropdown hover R shiny

Question

I am looking for a solution for a multi level dropdown in R shiny

I have browsed most of the packages here, https://github.com/nanxstats/awesome-shiny-extensions Wasn't able to find a solution in any of the available packages

A close solution is

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

Except that when the list are very long it is very difficult to manage

p.s. question and image are from https://github.com/rstudio/shiny/issues/2729

Answer 1

I've just done a package. It uses the JavaScript library jquery-contextMenu. To install it:

remotes::install_github("stla/NestedMenu")

Note that this is just a draft for the moment.

Usage example:

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)