Selected input loses hierarchy

[casa-henrym]

I've got a fairly large menu structure (almost 10k menu items) and there is a lot of repetition in the leaf nodes - the parent level provides critical context which is needed to identify what data the leaf node relates to. From what I can see, just using str() to display the selected values, the results are returned as a one-dimensional list and the hierarchy is lost. Is there a way around this?

I have started using jsTreeR after struggling with the limitations of shinyTree, but shinyTree did maintain the structure of the menu data, so I'm thinking this must be possible.

Here is an example:

library(shiny)
library(jsTreeR)

shinyApp(
    ui = fluidPage(
        titlePanel("Multi-level menu example"),
        fluidRow(
            column(6, jstreeOutput("menu")),
            column(6, verbatimTextOutput("str"))
        )
    ),
    server = function(input, output) {
        output$menu <- renderJstree({
            jstree(
                list(
                    list(
                        text = "Product A",
                        children = list(
                            list(
                                text = "Version 3",
                                children = list(
                                    list(text = "A"),
                                    list(text = "B"),
                                    list(text = "C")
                                )
                            ),
                            list(
                                text = "Version 2",
                                children = list(
                                    list(text = "A"),
                                    list(text = "B"),
                                    list(text = "C")
                                )
                            ),
                            list(
                                text = "Version 1",
                                children = list(
                                    list(text = "A"),
                                    list(text = "B")
                                )
                            )
                        )
                    ),
                    list(
                        text = "Product B",
                        children = list(
                            list(
                                text = "Version 1",
                                children = list(
                                    list(text = "A")
                                )
                            )
                        )
                    )
                )
            , checkboxes = TRUE)
        })
        output$str <- renderPrint({
            req(input$menu_selected)
            str(input$menu_selected)
        })
    }
)

[casa-henrym]

I have found that I can achieve the desired functionality by embedding the hierarchy in the "data" field of each node (see below).

However, using this method is undesirable because it blows out the size of the data that needs to be transferred to/from the client, and the information held in the data field is entirely redundant.

library(shiny)
library(jsTreeR)

shinyApp(
    ui = fluidPage(
        titlePanel("Multi-level menu example"),
        fluidRow(
            column(6, jstreeOutput("menu")),
            column(6, verbatimTextOutput("str"))
        )
    ),
    server = function(input, output) {
        output$menu <- renderJstree({
            jstree(
                list(
                    list(
                        text = "Product A",
                        data = list(Product = "A"),
                        children = list(
                            list(
                                text = "Version 3",
                                data = list(Product = "A", Version = "3"),
                                children = list(
                                    list(text = "A", data = list(Product = "A", Version = "3", leaf = "A")),
                                    list(text = "B", data = list(Product = "A", Version = "3", leaf = "B")),
                                    list(text = "C", data = list(Product = "A", Version = "3", leaf = "C"))
                                )
                            ),
                            list(
                                text = "Version 2",
                                data = list(Product = "A", Version = "2"),
                                children = list(
                                    list(text = "A", data = list(Product = "A", Version = "2", leaf = "A")),
                                    list(text = "B", data = list(Product = "A", Version = "2", leaf = "B")),
                                    list(text = "C", data = list(Product = "A", Version = "2", leaf = "C"))
                                )
                            ),
                            list(
                                text = "Version 1",
                                data = list(Product = "A", Version = "1"),
                                children = list(
                                    list(text = "A", data = list(Product = "A", Version = "1", leaf = "A")),
                                    list(text = "B", data = list(Product = "A", Version = "1", leaf = "B"))
                                )
                            )
                        )
                    ),
                    list(
                        text = "Product B",
                        data = list(Product = "B"),
                        children = list(
                            list(
                                text = "Version 1",
                                data = list(Product = "B", Version = "1"),
                                children = list(
                                    list(text = "A", data = list(Product = "B", Version = "1", leaf = "A"))
                                )
                            )
                        )
                    )
                )
            , checkboxes = TRUE)
        })
        output$str <- renderPrint({
            req(input$menu_selected)
            str(input$menu_selected)
        })
    }
)

[stla]

Hello,

Cool request. I can get the paths to the selected nodes like this:

However the data field is lost. It would be better to get a list list(path = "path/to/node", data = ......).

[stla]

That's done. If you want to try it: remotes::install_github("stla/jsTreeR@selected_paths"). Here is an example:

library(jsTreeR)
library(shiny)
library(jsonlite)

nodes <- list(
  list(
    text = "RootA",
    data = list(value = 999),
    icon = "far fa-moon red",
    children = list(
      list(
        text = "ChildA1",
        icon = "fa fa-leaf green"
      ),
      list(
        text = "ChildA2",
        data = list(value = 11111),
        icon = "fa fa-leaf green"
      )
    )
  ),
  list(
    text = "RootB",
    icon = "far fa-moon red",
    children = list(
      list(
        text = "ChildB1",
        icon = "fa fa-leaf green"
      ),
      list(
        text = "ChildB2",
        icon = "fa fa-leaf green"
      )
    )
  )
)

ui <- fluidPage(

  tags$head(
    tags$style(
      HTML(c(
        ".red {color: red;}",
        ".green {color: green;}",
        ".jstree-proton {font-weight: bold;}",
        ".jstree-anchor {font-size: medium;}",
        "pre {font-weight: bold; line-height: 1;}"
      ))
    )
  ),

  titlePanel("Drag and drop the nodes"),

  fluidRow(
    column(
      width = 3,
      jstreeOutput("jstree")
    ),
    column(
      width = 4,
      tags$fieldset(
        tags$legend(tags$span(style = "color: blue;", "All nodes")),
        verbatimTextOutput("treeState")
      )
    ),
    column(
      width = 4,
      tags$fieldset(
        tags$legend(tags$span(style = "color: blue;", "Selected nodes")),
        verbatimTextOutput("treeSelected")
      )
    )
  )

)

server <- function(input, output){

  output[["jstree"]] <- renderJstree({
    jstree(
      nodes, dragAndDrop = TRUE, checkboxes = TRUE,
      selectLeavesOnly = FALSE, theme = "proton"
    )
  })

  output[["treeState"]] <- renderPrint({
    toJSON(input[["jstree"]], pretty = TRUE, auto_unbox = TRUE)
  })

  output[["treeSelected"]] <- renderPrint({
    toJSON(input[["jstree_selected_paths"]], pretty = TRUE, auto_unbox = TRUE)
  })

}

shinyApp(ui, server)

[casa-henrym]

Thanks!

The forward-slash separator will be problematic - can path be a list?

Just to describe what I'm trying to do a bit more: the selected nodes will be turned into an SQL query to extract the relevant data and display it in the Shiny app. For example, using my menu structure: if I select the "Version 3" node the input$menu_selected_paths shows the four selected nodes:

List of 4
 $ :List of 2
  ..$ path: chr "Product A/Version 3"
  ..$ data:List of 2
  .. ..$ Product: chr "A"
  .. ..$ Version: chr "3"
 $ :List of 2
  ..$ path: chr "Product A/Version 3/A"
  ..$ data:List of 3
  .. ..$ Product: chr "A"
  .. ..$ Version: chr "3"
  .. ..$ leaf   : chr "A"
 $ :List of 2
  ..$ path: chr "Product A/Version 3/B"
  ..$ data:List of 3
  .. ..$ Product: chr "A"
  .. ..$ Version: chr "3"
  .. ..$ leaf   : chr "B"
 $ :List of 2
  ..$ path: chr "Product A/Version 3/C"
  ..$ data:List of 3
  .. ..$ Product: chr "A"
  .. ..$ Version: chr "3"
  .. ..$ leaf   : chr "C"

In this case where all the leaf nodes are selected then I don't want to include them all in the SQL - that would be redundant and I can use the second-level value to pick up all the leaf node values; my SQL would end up something along the lines of SELECT * FROM FOO WHERE PRODUCT = 'A' AND VERSION = 3.

So for this example I need to remove the last three nodes; I would do something like foreach node, if node$path is a superset any other node$path, then this is a child of that node and can be discarded. I'm conscious that this is O(n^2) so it would be nice if the package had an optimised function to support this operation. The Javascript already knows about levels in the hierarchy, so this can be implemented by the package in O(1), right?

I hope that all makes sense. The reason I mention this is because I think this is probably a fairly common use-case, and it would be nice if the package included support for this.

[stla]

Hi,

I don't know whether this will be appropriate for you but I implemented a new Shiny input value, input$ID_selected_tree. It returns the selected nodes with their ascendants, like this:

To be available, you have to set checkboxes=TRUE in the jstree function.

Installation: remotes::install_github("stla/jsTreeR@casa").

[stla]

I close, but feel free to reopen or to continue the discussion. I hope your problem is solved.