Reactive tree on datatable click in Shiny

Question

I'm trying to build a tree which would react when clicking on a row of a datatable. Especially, I would like the corresponding leaf of the tree to be highlighted. How can I achieve that ? Here is a sample code:

library(shiny)
library(DT)
library(shinyTree)
library(shinyjs)

# Data.frame
data <- data.frame(
  ID = 1:10,
  Name = c("Alice", "Bob", "Charlie", "David", "Eve", "Frank", "Grace", "Hank", "Ivy", "Jack"),
  Age = c(25, 32, 45, 28, 40, 52, 34, 29, 37, 48),
  Score = c(85, 92, 78, 88, 76, 95, 81, 89, 70, 93)
)

ui <- fluidPage(
  DTOutput("table"),
  shinyTree("tree")
)

server <- function(input, output, session) {
  
  # Datatable
  output$table <- renderDT({
    datatable(data, selection = 'single', rownames = FALSE, callback = JS(
      "table.on('click', 'tr', function() {",
      "  var index = table.row(this).index();",
      "  Shiny.setInputValue('selected_row', index);",
      "});"
    ))
  })
  
  # Reactive highlight on click
  observeEvent(input$selected_row, {

    ### Strunggling from here ###

    create_tree(data, c("Age", "Name"))

    }
  })
}

The tree would be something like this - using renderTree to look good. Such that, when selecting a row, e.g. Bob from the dataframe, the leaf corresponding to Bob is highlighted.

1  Root           
2   ¦--25         
3   ¦   °--Alice  
4   ¦--32         
5   ¦   °--Bob    
6   ¦--45         
7   ¦   °--Charlie
8   ¦--28         
9   ¦   °--David  
10  ¦--40         
11  ¦   °--Eve    
12  ¦--52         
13  ¦   °--Frank  
14  ¦--34         
15  ¦   °--Grace  
16  ¦--29         
17  ¦   °--Hank   
18  ¦--37         
19  ¦   °--Ivy    
20  °--48         
21      °--Jack   

Answer 1

library(shiny)
library(DT)
library(jsTreeR)

nodes <- list(
  list(
    text = "Root",
    state = list(opened = TRUE),
    children = list(
      list(
        text = "Alice",
        state = list(opened = TRUE),
        children = list(
          list(
            text = "25",
            li_attr = list(id = "leaf1")
          )
        )
      ),
      list(
        text = "Bob",
        state = list(opened = TRUE),
        children = list(
          list(
            text = "32",
            li_attr = list(id = "leaf2")
          )
        )
      )
    )
  )
)

dat <- data.frame(
  ID    = 1:10,
  Name  = c("Alice", "Bob", "Charlie", "David", "Eve", "Frank", "Grace", "Hank", "Ivy", "Jack"),
  Age   = c(25, 32, 45, 28, 40, 52, 34, 29, 37, 48),
  Score = c(85, 92, 78, 88, 76, 95, 81, 89, 70, 93)
)

ui <- fluidPage(
  br(),
  fluidRow(
    column(
      3,
      jstreeOutput("tree")
    ),
    column(
      9,
      DTOutput("dtable")
    )
  )
)

server <- function(input, output, session) {
  
  output[["tree"]] <- renderJstree(
    jstree(nodes)
  )
  
  output[["dtable"]] <- renderDT({
    datatable(
      dat, selection = "single", rownames = FALSE, callback = JS(
        "table.on('click', 'tbody tr', function() {",
        "  var index = 1 + table.row(this).index();",
        "  var id = '#leaf' + index;",
        "  $('#tree').jstree('deselect_all');",
        "  $('#tree').jstree('select_node', id);",
        "});"
      )
    )
  })
}

shinyApp(ui, server)

Answer 2

I made a somewhat ugly solution; I'm not very knowledgeable on shinytree but I found that making the structure inside a reactive enviroment was the simplest way to specify the properties of the structure. You can use this as a starting point if this logic suits you.

library(shiny)
library(DT)
library(shinyTree)
library(shinyjs)

ui <- fluidPage(
  DTOutput("table"),
  shinyTree("tree"),
  verbatimTextOutput("aer")
)

server <- function(input, output, session) {
  
  
  tree <- reactive({
    
    condition1 <- if(input$table_rows_selected == 1) TRUE else FALSE
    condition2 <- if(input$table_rows_selected == 2) TRUE else FALSE
    condition3 <- if(input$table_rows_selected == 3) TRUE else FALSE
    condition4 <- if(input$table_rows_selected == 4) TRUE else FALSE
    condition5 <- if(input$table_rows_selected == 5) TRUE else FALSE
    condition6 <- if(input$table_rows_selected == 6) TRUE else FALSE
    condition7 <- if(input$table_rows_selected == 7) TRUE else FALSE
    condition8 <- if(input$table_rows_selected == 8) TRUE else FALSE
    condition9 <- if(input$table_rows_selected == 9) TRUE else FALSE
    condition10 <- if(input$table_rows_selected == 10) TRUE else FALSE
    
    list(`1` = structure(list(Alice = structure(0, stselected = condition1)), stselected = condition1, stopened = condition1),
         `2` = structure(list(Bob = structure(0, stselected = condition2)), stselected = condition2, stopened = condition2),
         `3` = structure(list(Charlie = structure(0, stselected = condition3)), stselected = condition3, stopened = condition3), 
         `4` = structure(list(David = structure(0, stselected = condition4)), stselected = condition4, stopened = condition4),
         `5` = structure(list(Eve = structure(0, stselected = condition5)), stselected = condition5, stopened = condition5), 
         `6` = structure(list(Frank = structure(0, stselected = condition6)), stselected = condition6, stopened = condition6), 
         `7` = structure(list(Grace = structure(0, stselected = condition7)), stselected = condition7, stopened = condition7), 
         `8` = structure(list(Hank = structure(0, stselected = condition8)), stselected = condition8, stopened = condition8),
         `9` = structure(list(Ivy = structure(0, stselected = condition9)), stselected = condition9, stopened = condition9),
         `10` = structure(list(Jack = structure(0, stselected = condition10)), stselected = condition10, stopened = condition10))
  })
  
  output$table <- renderDT({
    datatable(data, selection = 'single')
  })
  
  output$tree <- renderTree({
    
    tree()

  })
}

shiny::shinyApp(ui = ui, server = server)