Search code examples
shinyshinytree

shinyTree not rendering checkbox output


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?


Solution

  • 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)