How to filter dataframe based on tree input

Question

I aim to apply a filter to the datatable using the tree input, which incorporates a hierarchical code with four levels. I intend for the datatable to consistently filter based on the fourth-level code whenever any parent level is selected. How can I implement this using the tree input?

Below is my script.

library(shiny)
library(jsTreeR)

ui <- fluidPage(
  dropdownButton(
    inputId = "mydropdown",
    label = "Select products",
    icon = "",
    status = "primary",
    circle = FALSE,
    jstreeOutput("mytree")

  ),
  
  DTOutput("table")
  
)

server <- function(input, output, session) {
  
  
  df <- data.frame(
    all = c("All product","All product","All product","All product","All product","All product","All product","All product",
            "All product","All product","All product","All product","All product","All product","All product","All product"),
    category = c("Agriculture","Agriculture","Agriculture","Agriculture", "Agriculture","Agriculture","Agriculture","Agriculture",
                 "Non Agriculture", "Non Agriculture", "Non Agriculture", "Non Agriculture","Non Agriculture", "Non Agriculture", "Non Agriculture", "Non Agriculture"),
    HS2 = c("01","01","01","01","02","02","02","02","03","03","03","03","04","04","04","04"),
    HS4 = c("0101","0101","0102","0102","0201","0201","0202","0202","0301","0301","0302","0302","0401","0401","0402","0402"),
    HS6 = c("010101","010102", "010201","010202","020101","020102","020201","020202","030101","030102", "030201","030202","040101","040102","040201","040202")
  )
  
  output$mytree <- renderJstree({
    
    makeNodes <- function(leaves){
      dfs <- lapply(strsplit(leaves, "/"), function(s){
        item <-
          Reduce(function(a,b) paste0(a,"/",b), s[-1], s[1], accumulate = TRUE)
        data.frame(
          item = item,
          parent = c("root", item[-length(item)]),
          stringsAsFactors = FALSE
        )
      })
      dat <- dfs[[1]]
      for(i in 2:length(dfs)){
        dat <- merge(dat, dfs[[i]], all = TRUE)
      }
      f <- function(parent){
        i <- match(parent, dat$item)
        item <- dat$item[i]
        children <- dat$item[dat$parent==item]
        label <- tail(strsplit(item, "/")[[1]], 1)
        if(length(children)){
          list(
            text = label,
            children = lapply(children, f),
            icon =FALSE,
            state = list(selected = TRUE, opened = FALSE )
          )
        }else{
          list(text = label, type = "child",icon = FALSE,
               state = list(selected = TRUE,opened = FALSE ))
        }
      }
      lapply(dat$item[dat$parent == "root"], f)
    }
    
    # the dataframe
    
    
    # transform it to a vector of paths
    paths <- apply(df, 1, function(x) paste0(x, collapse = "/"))
    
    # make the nodes list
    nodes <- makeNodes(paths)
    
 
    
  
    jstree(
      nodes,
      checkboxes = TRUE,
      theme = "proton",
      checkCallback = JS("$.jstree.defaults.core.expand_selected_onload = false;")
    )
    
  })
  
  output$table <- renderDT({
    datatable(df)
  })
  
 

}

shinyApp(ui, server)

Answer 1

The paths whose ending node is checked are in input$mytree_checked_paths, so you can use this input to filter the dataframe.

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

makeNodes <- function(leaves){
  dfs <- lapply(strsplit(leaves, "/"), function(s){
    item <-
      Reduce(function(a,b) paste0(a,"/",b), s[-1], s[1], accumulate = TRUE)
    data.frame(
      item = item,
      parent = c("root", item[-length(item)]),
      stringsAsFactors = FALSE
    )
  })
  dat <- dfs[[1]]
  for(i in 2:length(dfs)){
    dat <- merge(dat, dfs[[i]], all = TRUE)
  }
  f <- function(parent){
    i <- match(parent, dat$item)
    item <- dat$item[i]
    children <- dat$item[dat$parent==item]
    label <- tail(strsplit(item, "/")[[1]], 1)
    if(length(children)){
      list(
        text = label,
        children = lapply(children, f),
        icon =FALSE,
        state = list(selected = TRUE, opened = FALSE )
      )
    }else{
      list(text = label, type = "child",icon = FALSE,
           state = list(selected = TRUE,opened = FALSE ))
    }
  }
  lapply(dat$item[dat$parent == "root"], f)
}

dat <- data.frame(
  all = c("All product","All product","All product","All product","All product","All product","All product","All product",
          "All product","All product","All product","All product","All product","All product","All product","All product"),
  category = c("Agriculture","Agriculture","Agriculture","Agriculture", "Agriculture","Agriculture","Agriculture","Agriculture",
               "Non Agriculture", "Non Agriculture", "Non Agriculture", "Non Agriculture","Non Agriculture", "Non Agriculture", "Non Agriculture", "Non Agriculture"),
  HS2 = c("01","01","01","01","02","02","02","02","03","03","03","03","04","04","04","04"),
  HS4 = c("0101","0101","0102","0102","0201","0201","0202","0202","0301","0301","0302","0302","0401","0401","0402","0402"),
  HS6 = c("010101","010102", "010201","010202","020101","020102","020201","020202","030101","030102", "030201","030202","040101","040102","040201","040202")
)

paths <- apply(dat, 1, function(x) paste0(x, collapse = "/"))
dat$path <- paths

# make the nodes list
nodes <- makeNodes(paths)

ui <- fluidPage(
  fluidRow(
    column(
      5,
      jstreeOutput("mytree")
    ),
    column(
      7,
      DTOutput("table")
    )
  )
)

server <- function(input, output, session) {
  
  output[["mytree"]] <- renderJstree({
    jstree(
      nodes,
      checkboxes = TRUE,
      selectLeavesOnly = TRUE,
      theme = "proton"
    )
  })
  
  Dat <- eventReactive(input[["mytree_checked_paths"]], {
    paths <- sapply(input[["mytree_checked_paths"]], `[[`, "path")
    subset(
      dat, 
      subset = path %in% paths, 
      select = c("category", "HS2", "HS4", "HS6")
    )
  })
  
  output[["table"]] <- renderDT({
    datatable(Dat())
  })
  
}

shinyApp(ui, server)