Shiny App stops working when I change filters

[dsgeek]

Hello all,

I am trying to add labels to my leaflet map. But when I add the labels, every time I remove certain fields under a certain variable, the app becomes grey in color like the pic below:

So if I remove Robert for instance, it'll become grey. Would you please check my code and see what is happening. I created a reprex that actually works fine, but it is only when I apply this code to my real data (49000) observations that the app stops working.

This is a code of the reprex and it works fine, but applying it to the orginial data sets leads to the above map becoming grey;

library(dplyr)
library(shiny)
library(leaflet)


## Data

Latitude = c(33.79053,34.31533,21.44848,33.89115, 29.54777, 29.64597, 30.21765, 29.90082)
Longitude = c(-84.0348,-83.8166,-158.003, -117.295,-95.101,-95.5768,-95.341,-95.6294)
Worker = c('A','A','B','B','C','D','E','F')
Max.Distance.from.C.or.HB = c(35,55,75,100,25,15,18,17)
Manager = c('Andrew_XXXXX','Andrew_XXXXX','Andy_YYYY',
            'Andy_YYYY', 'Robert_ZZZ',
            'Robert_ZZZ','Robert_ZZZ','Robert_ZZZ')
Days = c('Tuesday','Monday','Monday',
         'Tuesday', 'Wednesday',
         'Wednesday','Wednesday','Wednesday')
Skills = c('FMCC Dealer','AFG', 'Ally Financial','Nissan Dealer','Nissan Home', 'FMCC Dealer',
           'FMCC Customer', 'Nissan Dealer' )
Inspector = c('YES','YES','NO','YES',
              'YES','NO','YES','YES')


coverage_data <- data.frame(Latitude,Longitude,Worker, Max.Distance.from.C.or.HB, Manager,
                            Days, Skills, Inspector)

# Convert to miles

coverage_data <- coverage_data %>%
  mutate(Radius = coverage_data$Max.Distance.from.C.or.HB * 1609.34)


# Add labels

coverage_data$label <- paste("<p>", coverage_data$Worker, "</p>",
                             "<p>", coverage_data$Manager, "</p>",
                             "<p>", coverage_data$Days, "</p>",
                             "<p>", coverage_data$Skills, "</p>",
                             "<p>", coverage_data$Inspector, "</p>",
                             sep = '')


# App 

ui <- bootstrapPage(
  h1("Inspector Coverage App"),
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width = "100%", height = "100%"),
  absolutePanel(bottom = 6, left = 6,
                # sliderInput("range","Radius", min(coverage_data$Radius), max(coverage_data$Radius),
                #             value = range(coverage_data$Radius), step = 10
                # ),
                selectInput(inputId = "selection_days", label = "Days:",
                            choices = c("Monday" = "Monday",
                                        "Tuesday" = "Tuesday",
                                        "Wednesday" = "Wednesday"
                            ), multiple = TRUE, selected = 'Monday'),
                selectInput(inputId = "selection_manager", label = "Manager:",
                            choices = c("Andrew_XXXXX" = "Andrew_XXXXX",
                                        "Andy_YYYY" = "Andy_YYYY",
                                        "Robert_ZZZ" = "Robert_ZZZ"
                            ), multiple = TRUE, selected = c('Andrew_XXXXX', 'Andy_YYYY')),
                selectInput(inputId = "selection_worker", label = "Worker:",
                            choices = c("A",'B','C','D','E','F'), multiple = TRUE, selected = c('A','B','D')),
                selectInput(inputId = "selection_skill", label = "Skills:",
                            choices = c("FMCC Dealer",'AFG','Ally Financial','Nissan Home',
                                        'FMCC Customer','Nissan Dealer'), multiple = TRUE, selected = c('FMCC Dealer','FMCC Customer')),
                selectInput(inputId = 'selection_inspector', label= "Inspector:",
                            choices = c("YES", "NO"), multiple = TRUE, selected = 'YES')
  )
)



server <- function(input, output, session) { 
  
  # filteredData <- reactive({
  #   coverage_data[coverage_data$Radius >= input$range[1] & coverage_data$Radius <= input$range[2],]
  # })
  
  filteredData2 <- reactive({
    coverage_data %>%
      filter(coverage_data$Days %in% input$selection_days &
               coverage_data$Manager %in% input$selection_manager & 
               coverage_data$Worker %in% input$selection_worker &
               coverage_data$Skills %in% input$selection_skill &
               coverage_data$Inspector %in% input$selection_inspector)
    
  })
  
  
  ## From ui to server use reactive .. 
  
  
  pal <- colorFactor(
    palette = 'Set1',   #Dark2 is another palette option
    domain = coverage_data$Worker
  )
  
  # coverage_data$category <- factor(sample.int(5L, nrow(coverage_data$Worker), TRUE))
  # factpal <- colorFactor(topo.colors(5), Worker$category)
  
  ## Result -- from server to ui
  output$map <- renderLeaflet({
    leaflet(coverage_data) %>%
      setView(lng = -95.7129, lat = 34.0902, zoom = 4.499) %>%
      addProviderTiles(providers$OpenStreetMap.France) # %>%
    #fitBounds(~min(Longitude),~min(Latitude), ~max(Longitude),~max(Latitude))   
  })
  
  observe({
    leafletProxy("map", data = filteredData2()) %>%
      clearShapes() %>%
      addCircles(#lng = coverage_data$Longitude,
        #lat = coverage_data$Latitude,
        #color = ~pal(Worker),
        color = ~pal(filteredData2()$Worker),
        weight = 1,
        radius = ~filteredData2()$Radius,
        opacity = 0.5,
        label = lapply(coverage_data$label, HTML),
        fillOpacity = 0.5
      )
  })
}

shinyApp(ui,server)

[pieterjanvc]

Hi again

Although the Reprex is not generating any issues, which kind of is defeating the concept of a Reprex lol, I think you're making the same mistake as last time, namely using the wrong variable in your leafletProxy to update the labels.

This is the new code:

 observe({

    if(length(filteredData2()$label) > 0){
      labels = lapply(filteredData2()$label, HTML)
    } else {
      labels = NULL
    }

    leafletProxy("map", data = filteredData2()) %>%
      clearShapes() %>%
      addCircles(#lng = coverage_data$Longitude,
        #lat = coverage_data$Latitude,
        #color = ~pal(Worker),
        color = ~pal(filteredData2()$Worker),
        weight = 1,
        radius = ~filteredData2()$Radius,
        opacity = 0.5,
        label = labels,
        fillOpacity = 0.5
      )
  })

You were again using the non-filtered coverage_data instead of the filteredData2(). In this case substitution was a bit more complex as the lapply will not like the variable to be empty when there is no match (as in the default state), so we have to account for that with the if statement.

Try this code and let me know if it helps, if not, please try and come up with a real Reprex

Good luck,
PJ

[dsgeek]

Hi again

So even if I use label = lapply(filteredData2()$label, HTML), in observe, I don't get the right answer. But when you added the if function, it works like a charm. So it works now. Thanks a lot!

Now I can worry about another problem Thanks a lot pieterjanvc!

[pieterjanvc]

Hi,

You're welcome

No as I told you, using label = lapply(filteredData2()$label, HTML) directly wont work as the lapply freaks out if the list to apply over is empty. This is the case when filteredData2() has no rows because noting matches the filter. That's why you do the if function separately and in case nothing passes through the filter, you return NULL for the labels.

Grtz,
PJ

[dsgeek]

Awesome! I get it.