rshinydrag-and-dropsortablejsjstreer

How to build a drag and drop hierarchical tree with user inputs using shinyTree, jsTreeR, or similar package?


This is a follow-on to post How to build a drag and drop hierarchical tree that automatically updates. I am exploring the ways to visualize and manipulate a hierarchical tree in Shiny, in order to allow the user to flexibly apply a sequence of mathematical operations. The hierarchical tree would allow the user to arrange the order of mathematical operations (preferably using drag and drop), and make certain inputs, as shown in the illustration at the bottom.

Initially and ideally when invoking, the user would be presented with one parent and an allocation of 100% to that parent. From there, the user would have the ability to add parents/children/nodes, to build out a hierarchy tree of increasing complexity; preferably using drag/drop or list of options with a right mouse button click for example.

I've been reviewing packages jsTreeR and shinyTree, and they seem like they might work for this purpose. If you think these work, can you provide with any examples to get me started on the right path? Or are there other packages that might work better for this? My last resort may be rhandsontable for an Excel-like approach, which is my default mindset from years of using XLS, but that would be giving up on my visual aspiration. I've also been exploring the shinyDND and sortable packages which might ultimately work, but I need to explore all options early before risking getting stuck in a rabbit hole. And also as I fiddle with hierarchy trees they seem to make the most sense, visually, for the context of my application.

Example reproducible code (it could give me a start in the right direction):

library(shiny)
library(shinyTree)

values_parents <- function(tree){
  sapply(tree, function(parent) attr(parent, "stinfo"))
}

total_values_children <- function(tree){
  sapply(
    lapply(tree, function(parent){
      sapply(parent, function(children){
        attr(children, "stinfo")
      })
    }),
    function(x){if(is.list(x)) NA else sum(x)}
  )
}

ui <- fluidPage(
  tags$head(
    tags$style(HTML("pre {font-size: 17px;} .jstree-anchor {font-size: large;}"))
  ),
  fluidRow(
    column(
      width = 6,
      shinyTree("tree", dragAndDrop = TRUE, checkbox = FALSE)
    ),
    column(
      width = 6,
      tags$fieldset(
        tags$legend("Values of parents:"),
        verbatimTextOutput("parentsValues")
      ),
      br(),
      tags$fieldset(
        tags$legend("Total value of children:"),
        verbatimTextOutput("childrenTotalValue")
      )
    )
  )
)


server <- function(input, output, session) {
  
  output[["tree"]] <- renderTree({
    list(
      
      ParentA = structure(list(
        ChildrenA1 = structure(NA, stinfo = 5),
        ChildrenA2 = structure(NA, stinfo = 4)
      ), 
      stinfo = 10, stopened = FALSE),
      
      ParentB = structure(list(
        ChildrenB1 = structure(NA, stinfo = 6),
        ChildrenB2 = structure(NA, stinfo = 8)
      ), 
      stinfo = 12, stopened = FALSE)
      
    )
  })
  
  output[["parentsValues"]] <- renderPrint({
    values_parents(input[["tree"]])
  })
  
  output[["childrenTotalValue"]] <- renderPrint({
    total_values_children(input[["tree"]])
  })
  
}

shinyApp(ui, server)

Illustration: enter image description here


Solution

  • I'd give shinyTree a try. It seems to fit your requirements when setting dragAndDrop = TRUE and contextmenu = TRUE:

    library(shiny)
    library(shinyTree)
    
    ui <- fluidPage(
      pageWithSidebar(
        # Application title
        headerPanel("Simple shinyTree!"),
        
        sidebarPanel(
          helpText(HTML("A simple Shiny Tree example.
                      <hr>Created using <a href = \"http://github.com/trestletech/shinyTree\">shinyTree</a>."))
        ),
        mainPanel(
          shinyTree("tree", stripes = TRUE, multiple = FALSE, animation = FALSE, dragAndDrop = TRUE, contextmenu = TRUE)
        )
      )
    )
    
    server <- function(input, output, session) {
      output$tree <- renderTree({
        list(
          root1 = "",
          root2 = list(
            SubListA = list(leaf1 = "", leaf2 = "", leaf3=""),
            SubListB = list(leafA = "", leafB = "")
          ),
          root3 = list(
            SubListA = list(leaf1 = "", leaf2 = "", leaf3=""),
            SubListB = list(leafA = "", leafB = "")
          )
        )
      })
    }
    
    shinyApp(ui, server)
    

    result