shinyTree not rendering checkbox output

Question

I am using shinyTree to render a data table. The following is the dataset with codes used so far:

library(shiny)
library(shinyTree)

newdat <- structure(list(RESPID = c("41000123", "41004132", "41006132", 
"41007121", "41007123"), PDT_A = c(125, 66, 45, 28, 
0), PDT_B = c(10, 0, 0, 0, 0), PDT_C = c(0, 0, 0, 0, 0), PDT_D = c(450, 
105, 75, 192, 0), PDT_TOTAL = c(585, 171, 120, 220, 0)), .Names = c("RESPID", 
"PDT_A", "PDT_B", "PDT_C", "PDT_D", "PDT_TOTAL"), row.names = c("6", 
"40", "56", "59", "61"), class = "data.frame")


server <- shinyServer(function(input, output, session) {

    newdata <- reactive({newdat})

  output$tree <- renderTree({
    sss=list('TOTAL_VALUE'= list('TOTAL_VALUE_OF_MERCHANDISE'   =  structure(list('PDT_TOTAL'='1001'), stopened=FALSE),
        'PDT_CAT'   =  structure(list('PDT_TOTAL'='1002','PDT_A'='152','PDT_B'='153','PDT_C'='154','PDT_D'='155'), stopened=FALSE)
        ))
    attr(sss[[1]],"stopened")=FALSE 
    sss
  })

  catdat <- reactive({
      tree <- input$tree
      unlist(get_selected(tree))
  })

  coldat <- reactive({
      newdata()[,catdat()]
  })

  output$datatab <- renderDataTable({
        coldat()
  })


})


ui <- shinyUI(
  pageWithSidebar(
    headerPanel("TEST"),
    sidebarPanel(
      shinyTree("tree", checkbox = TRUE)
    ),
    mainPanel(
      dataTableOutput("datatab")
    )
  ))

shinyApp(ui,server)

The tree gets generated. I have following trouble in rendering the columns through data table output:

1. The first branch of the tree, refers to only one column: which is not rendering in shiny. I am getting an error message undefined columns selected .

2. The second branch of the tree supposed to render all five columns of the table. However it renders only any four of the columns.

If i select root of the second branch, i am getting the same undefined columns selected . When I uncheck one of the branch the table with 4 columns gets rendered.

How do i render all the columns? Is there a way where I can remove the check boxes at the branch root / nodes level?

Answer 1

Ad 1. You get this error because if you select the first branch of the tree, then catdat() returns a vector with "PDT_TOTAL" and "TOTAL_VALUE_OF_MERCHANDISE" and there is no such variable as "TOTAL_VALUE_OF_MERCHANDISE" in your dataset.

Ad 2. If you select all five options then catdat() returns additionally "PDT_CAT" and you have the same problem as above - there is no such variable in your dataset. (Same above - if you select all options, so "PDT_TOTAL" , it returns additionally "TOTAL_VALUE_OF_MERCHANDISE" )

---

To render all columns you could do following:

First, select dynamically variables from your dataset and then remove duplicates as catdat() returns twice "TOTAL_VALUE" when the very first option TOTAL_VALUE is selected.

There is also another issue: newdata()[,vars] returns a vector if there is only one variable selected and renderDataTable won't print anything as it works only with dataframes. To address this issue you can remove , to ensure that the subsetting returns always a dataframe - newdata()[vars]

coldat <- reactive({
    vars <- catdat()
    vars <- vars[!(vars %in% c("TOTAL_VALUE", "TOTAL_VALUE_OF_MERCHANDISE", "PDT_CAT"))]
    vars <- unique(vars)
    print(vars)

    # newdata()[,vars] # If you select only one variable then this reactive returns an object of class numeric and not a data.frame
    newdata()[vars] # remove "," and it will always return a data frame
  })

---

Full example:

library(shiny)
library(shinyTree)

newdat <- structure(list(RESPID = c("41000123", "41004132", "41006132", 
                                    "41007121", "41007123"), PDT_A = c(125, 66, 45, 28, 
                                                                       0), PDT_B = c(10, 0, 0, 0, 0), PDT_C = c(0, 0, 0, 0, 0), PDT_D = c(450, 
                                                                                                                                          105, 75, 192, 0), PDT_TOTAL = c(585, 171, 120, 220, 0)), .Names = c("RESPID", 
                                                                                                                                                                                                              "PDT_A", "PDT_B", "PDT_C", "PDT_D", "PDT_TOTAL"), row.names = c("6", 
                                                                                                                                                                                                                                                                              "40", "56", "59", "61"), class = "data.frame")


server <- shinyServer(function(input, output, session) {

  newdata <- reactive({newdat})

  output$tree <- renderTree({
    sss=list('TOTAL_VALUE'= list('TOTAL_VALUE_OF_MERCHANDISE'   =  structure(list('PDT_TOTAL'='1001'), stopened=FALSE),
                                 'PDT_CAT'   =  structure(list('PDT_TOTAL'='1002','PDT_A'='152','PDT_B'='153','PDT_C'='154','PDT_D'='155'), stopened=FALSE)
    ))
    attr(sss[[1]],"stopened")=FALSE 
    sss
  })

  catdat <- reactive({
    tree <- input$tree
    unlist(get_selected(tree))
  })

  coldat <- reactive({
    vars <- catdat()
    vars <- vars[!(vars %in% c("TOTAL_VALUE", "TOTAL_VALUE_OF_MERCHANDISE", "PDT_CAT"))]
    vars <- unique(vars)
    print(vars)

    # newdata()[,vars] # If you select only one variable then this reactive returns an object of class numeric and not a data.frame
    newdata()[vars] # remove "," and it will always return a data frame
  })

  output$datatab <- renderDataTable({
    coldat()
  })


})


ui <- shinyUI(
  pageWithSidebar(
    headerPanel("TEST"),
    sidebarPanel(
      shinyTree("tree", checkbox = TRUE)
    ),
    mainPanel(
      dataTableOutput("datatab")
    )
  ))

shinyApp(ui,server)