R shiny graph shows error when i uncheck the default checbox, when graphs are plotted dynamically

Question

i am trying to plot graphs based on user input from checkboxes. it all works fine until i uncheck the first checkbox and an error pops up saying "no applicable method for 'ggplotly' applied to an object of class "NULL"". Even though other checkbox/es are checked, it gives anerror. for my codde to work, the first checkbox has to be mandatorily always checked. How do i resolve my code such that the graph is plotted based on user input and doesn't depend on the first checkbox only? my sample data has 3 columns, namely "distributor_name", "outlet_type" and "total_sales". it is a csv file and here, i am showing how my data looks like. EDIT- for these 8 rows, i get no errors, when number of rows increase, i get the following error.

library(ggplot2)

mydata <-structure(list(State_Name =  c("ANDAMAN AND NICOBAR ISLANDS","ANDAMAN AND NICOBAR ISLANDS","ANDAMAN AND NICOBAR ISLANDS","ANDAMAN AND NICOBAR ISLANDS","ANDAMAN AND NICOBAR ISLANDS","ANDAMAN AND NICOBAR ISLANDS","ANDAMAN AND NICOBAR ISLANDS","ANDAMAN AND NICOBAR ISLANDS"), 
                     District_Name   = c("ANDAMANS","ANDAMANS","ANDAMANS","ANDAMANS","ANDAMANS","ANDAMANS","ANDAMANS","ANDAMANS"),               
                     Place_Name= c("PORT BLAIR", "PORT BLAIR", "PORT BLAIR", "PORT BLAIR", "PORT BLAIR", "PORT BLAIR", "PORT BLAIR", "PORT BLAIR"), 
                     Distributor_Name = c("M.A. MOHMAD & SONS(S1145)","M.A.MOHMAD & SONS(S1145)","M.A.MOHMAD & SONS(S1145)","M.A.MOHMAD & SONS(S1145)", "M.A.MOHMAD & SONS(S1145)","M.A.MOHMAD & SONS(S1145)","M.A.MOHMAD & SONS(S1145)","M.A. MOHMAD & SONS(S1145)"), 
                     Product_Code= c("ALHF", "ARFM", "ARTT", "BNEF", "BNPP", "BNSS", "BNTI","COFM"), 
                     Product_Value=c(8839.2, 39777.3, 19092.96, 254577.61, 63640.8, 10608, 28284.8, 21214.57),
                     Qty =c(80,90,72,720,720,240,320,48),
                     Tto= c(8662.42, 38981.76, 18711.1, 249486.05, 62367.99, 10395.84, 27719.1, 20790.28)), 
.Names = c("State_Name", "District_Name","Place_Name","Distributor_Name","Product_Code","Product_Value","Qty", "Tto"), row.names = c(NA,-8L), class = "data.frame")



print(mydata)

mydata <- head(mydata,n=20)
dput(mydata)
depvar <- mydata$Tto

avail_wise <- setdiff(colnames(mydata), depvar)
avail_wise <- setNames(avail_wise,
                   paste0(avail_wise, "-wise"))
set.seed(20180307)


 # random fill/color assignments
colors <- data.frame(
  field = avail_wise,
  fill = sample(palette(), length(avail_wise), replace=TRUE),
  color = sample(palette(), length(avail_wise), replace=TRUE)
)
str(colors)
# de-magic-constant something later in the code
checkboxes_max_levels <- 10 # an arbitrary number, seems reasonable
ui <- fluidPage(
  theme = "bootstrap.css",
  titlePanel("Hello User"),
  fluidRow(
    column(3, wellPanel(
      selectInput("input_type", "Input type",
                  choices = avail_wise, selected = avail_wise[1] )
    ) ),
    column(9, wellPanel( uiOutput("ui") ))
  ),
  fluidRow(
    column(12, plotOutput("dynamic_value") )
  )
)

Server <- function(input, output) {
  output$ui <- renderUI({
    req(input$input_type)
    choices <- sort(unique(mydata[[input$input_type]]))
    if (is.factor(choices) || is.character(choices) || length(choices) < checkboxes_max_levels) {
      checkboxGroupInput("dynamic", paste0(input$input_type, "-wise"),
                         choices = choices, selected = choices[1],
                         inline = TRUE)
    } else {
      shiny::sliderInput("dynamic", paste0(input$input_type, "-wise"),
                         min = min(choices), max = max(choices),
                         value = round(quantile(choices, c(0.25,0.75)), 1))
    }
  })
  filtered <- reactive({
    req(input$dynamic)
    col <- filteredcolors()
    it <- isolate(input$input_type)
    if (is.character(input$dynamic)) {
      # checkboxGroupInput
      ind <- mydata[[it]] %in% input$dynamic
    } else {
      # sliderInput
      ind <- input$dynamic[1] <= mydata[[it]] & mydata[[it]] <= input$dynamic[2]
    }
    mydata[ind,,drop=FALSE]
  })
  filteredcolors <- reactive({
    dplyr::filter(colors, field == input$input_type)
  })
  # mydata.ordered <- mydata[order(mydata[,8]),]
  output$dynamic_value <- renderPlot({
    req(filtered())
    col <- filteredcolors()
    ggplot(filtered(), aes_string(depvar)) + 
      geom_histogram(fill=col$fill, col=col$color)
  })
}

shinyApp(ui = ui, server = Server)

]3

Answer 1

There are a few issues with your code.

1. if (input$dynamic == mydata1$distributor_name) is creating a logical vector, yet if requires its comparison to be length 1. This does produce results, but even if it is doing what you ultimately need, it is really bad practice to do this, and will almost certainly fail miserably in the future (when you least expect it). I suggest you accept that if must always be length-1, and move on; there are other conditional methods that take longer vectors.

2. You are creating a ggplot and discarding it before moving on. This is indicative of iterative build processes, and not a problem per se in the final execution, it is inefficient at best.

3. Your conditions were checking for equality but your checkbox group allowed for multiple selections; you should be using %in% instead of ==.

Some suggested improvements, though your code is not "bad" in these senses:

4. Typically this type of app is written with exactly two arguments because it becomes a hard to manage all of the if/thens and state variables. I prefer to start from the beginning with a mindset of "2 or more", meaning a potentially arbitrary number of options. This of course, leads to number 6, ...

5. Calling checkboxGroupInput twice with barely-different arguments is a bit repetitive, you can reduce your code significantly. This doesn't speed it up, but it makes it much easier to read and maintain.

6. Based on my choice to allow arbitrary "column-wise" arguments (since my data here has several more), some of them are not discrete, so I'm going to use the dynamic UI in an interesting way: produce either checkboxes or a slider input. This produces some slight problems later, for which I do not have an elegant solution, but I do have a functional one.

Additionally, some shiny recommendations:

7. Use reactivity smartly. This involves things like the use of req(input$dynamic) to make sure that $dynamic is "truthy" (initialized, non-NULL, etc) before that block executes. It makes transitions when switching other larger items significantly smoother.

8. Be wary of blocks that refresh crazily. For example, if B depends on A, and C depends on both A and B, it is possible that when A changes, C will refresh because of its dependency on A, and then B will update (due to A), causing C to refresh again. How do you know if there is dependency? Look for the top-level variables (input$...) and reactive variables (e.g., filtered() here). Where this is a problem, use isolate(A) in C. This is why I use isolate(input$input_type).

9. I added another layer of reactivity, choosing to have a reactive block that does nothing other than filter the data. This does not add much in this constrained example, but most apps use the filtered data in more than one UI element.

Since I don't have enough of your data to really do anything meaningful, I'll use mtcars. There are five variables that are "discrete" (cyl, vs, am, gear, and carb), all others are continuous. Because of the two types, I have the two types of delectors: checkboxGroupInput and sliderInput (with two ends).

Some global variables, making other areas of the code just a little clearer. Specifically, colors is a way I updated your if/then blocks to account for per-column coloring. Obviously this random method is silly and simpler ways almost always exist (based on your individual needs), but I went big early.

mydata <- mtcars
depvar <- "mpg"

avail_wise <- setdiff(colnames(mydata), depvar)
avail_wise <- setNames(avail_wise,
                       paste0(avail_wise, "-wise"))
set.seed(20180307)
# random fill/color assignments
colors <- data_frame(
  field = avail_wise,
  fill = sample(palette(), length(avail_wise), replace=TRUE),
  color = sample(palette(), length(avail_wise), replace=TRUE)
)
str(colors)
# de-magic-constant something later in the code
checkboxes_max_levels <- 10 # an arbitrary number, seems reasonable

I opted to move the plot to a second row. This is just aesthetic, and you can play with your layout.

library(shiny)
library(ggplot2)

ui <- fluidPage(
  theme = "bootstrap.css",
  titlePanel("Hello User"),
  fluidRow(
    column(3, wellPanel(
      selectInput("input_type", "Input type",
                  choices = avail_wise, selected = avail_wise[1] )
    ) ),
    column(9, wellPanel( uiOutput("ui") ))
  ),
  fluidRow(
    column(12, plotOutput("dynamic_value") )
  )
)

Lots of liberty taken here. Four big "blocks", for output$ui, filtered() data set, filteredcolors() ancillary dataset (could easily be reduced/improved), and output$dynamic_value (the plot).

Server <- function(input, output) {
  output$ui <- renderUI({
    req(input$input_type)
    choices <- sort(unique(mtcars[[input$input_type]]))
    if (is.factor(choices) || is.character(choices) || length(choices) < checkboxes_max_levels) {
      checkboxGroupInput("dynamic", paste0(input$input_type, "-wise"),
                         choices = choices, selected = choices[1],
                         inline = TRUE)
    } else {
      shiny::sliderInput("dynamic", paste0(input$input_type, "-wise"),
                         min = min(choices), max = max(choices),
                         value = round(quantile(choices, c(0.25,0.75)), 1))
    }
  })
  filtered <- reactive({
    req(input$dynamic)
    col <- filteredcolors()
    it <- isolate(input$input_type)
    if (is.character(input$dynamic)) {
      # checkboxGroupInput
      ind <- mtcars[[it]] %in% input$dynamic
    } else {
      # sliderInput
      ind <- input$dynamic[1] <= mtcars[[it]] & mtcars[[it]] <= input$dynamic[2]
    }
    mtcars[ind,,drop=FALSE]
  })
  filteredcolors <- reactive({
    dplyr::filter(colors, field == input$input_type)
  })
  output$dynamic_value <- renderPlot({
    req(filtered())
    col <- filteredcolors()
    ggplot(filtered(), aes_string(depvar)) +
      geom_histogram(fill=col$fill, col=col$color)
  })
}

shinyApp(ui = ui, server = Server)

EDIT

This can literally be done with any dataset that has a display-able variable. I've modified it slightly, so grab all of this (I tweaked several small pieces.)

All you have to do is assign mydata and then choose a column name and assign that string to depvar. Such as any of the following:

mydata <- mtcars
depvar <- "mpg"

# doesn't provide discrete variables, but ...
mydata <- iris
depvar <- "Sepal.Length"

# very interesting, histograms are actually meaningful
mydata <- diamonds
depvar <- "price"

mydata <- read.table(text='distributor_name    outlet_type   total_sales
abc                    pooj          120
def                    alkr           345
ghi                    mfjc           266
jkl                    zlwh           595', header=TRUE)
depvar <- "total_sales"

Take any one of these assignment pairs and replace the two lines at the top of this app, and you'll have a different data app.