d3Tree icon indicating copy to clipboard operation
d3Tree copied to clipboard

tree.filter() giving wrong filter expression?

Open ismirsehregal opened this issue 5 years ago • 0 comments

Hi thanks for sharing this great package!

I just started fiddling around with your Titanic example for reactive filters in shiny.

When the root is clicked twice, the filter expression for ID 1 changes from 'Class' to 'Titanic', which doesn't make any sense to me. I'm using d3Tree_0.2.0.

screen


Here is a modified version of the app (using data.table) and utilizing gsub for a workaround:

library(shiny)
library(d3Tree)
library(DT)
library(data.table)
library(datasets)

DT <- unique(setDT(as.data.frame(Titanic)))
variables <- names(DT)
rootName <- "Titanic"

ui <- fluidPage(fluidRow(
  column(
    7,
    column(8, style = "margin-top: 8px;",
      selectizeInput(
      "Hierarchy",
      "Tree Hierarchy",
      choices = variables,
      multiple = TRUE,
      selected = variables,
      options = list(plugins = list('drag_drop', 'remove_button'))
    )),
    column(4, tableOutput("clickView")),
    d3treeOutput(
      outputId = "d3",
      width = '1200px',
      height = '475px'
    ),
    column(12, DT::dataTableOutput("filterStatementsOut"))
  ),
  column(5, style = "margin-top: 10px;", DT::dataTableOutput('filteredTableOut'))
))

server <- function(input, output, session) {
  
  network <- reactiveValues(click = data.frame(name = NA, value = NA, depth = NA, id = NA))
  
  observeEvent(input$d3_update, {
    network$nodes <- unlist(input$d3_update$.nodesData)
    activeNode <- input$d3_update$.activeNode
    if (!is.null(activeNode))
      network$click <- jsonlite::fromJSON(activeNode)
  })
  
  output$clickView <- renderTable({
    req({as.data.table(network$click)})
  }, caption = 'Last Clicked Node', caption.placement = 'top')
  
  filteredTable <- eventReactive(network$nodes, {
    if (is.null(network$nodes)) {
      DT
    } else{
      filterStatements <- tree.filter(network$nodes, DT)
      filterStatements$FILTER <- gsub(pattern = rootName, replacement = variables[1], x = filterStatements$FILTER)
      network$filterStatements <- filterStatements
      DT[eval(parse(text = paste0(network$filterStatements$FILTER, collapse = " | ")))]
    }
  })
  
  output$d3 <- renderD3tree({
    if (is.null(input$Hierarchy)) {
      selectedCols <- variables
    } else{
      selectedCols <- input$Hierarchy
    }
    
    d3tree(
      data = list(
        root = df2tree(struct = DT[, ..selectedCols][, dummy.col := ''], rootname = rootName),
        layout = 'collapse'
      ),
      activeReturn = c('name', 'value', 'depth', 'id'),
      height = 18
    )
  })
  
  output$filterStatementsOut <- renderDataTable({
    req({network$filterStatements})
  }, caption = 'Generated filter statements', server = FALSE)
  
  output$filteredTableOut <- DT::renderDataTable({
    filteredTable()
  }, caption = 'Filtered table', server = FALSE, options = list(pageLength = 20))
  
}

shinyApp(ui = ui, server = server)

ismirsehregal avatar Jun 05 '19 12:06 ismirsehregal