More Circles than needed

shiny
1

Hello,

I am building an app that displays circles for different coordinates. I added two radioButtons and I want to display the intersection of the different variables on my map.

If I select (Manager == Robert_ZZZ and Days == 'Wednesday') then this will show all the circles of Robert on a Wednesday. In my reproducible example below, when I select Manager == Robert_ZZZ and Days == Wednesday, I see 8 circles, which doesn't make sense. I should only see 4 circles since Robert_ZZZZ appears 4 times with different coordinates on a Wednesday. I appreciate any help correcting my logic.

Reproducible Example:

# Load libraries
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')



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

# Convert to miles


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



# App 

ui <- bootstrapPage(
  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
                # ),
                radioButtons(inputId = "selection_days", label = "Days:",
                            choices = c("Monday" = "Monday",
                                        "Tuesday" = "Tuesday",
                                        "Wednesday" = "Wednesday"
                            )),
                radioButtons(inputId = "selection_manager", label = "Manager:",
                            choices = c("Andrew_XXXXX" = "Andrew_XXXXX",
                                        "Andy_YYYY" = "Andy_YYYY",
                                        "Robert_ZZZ" = "Robert_ZZZ"
                           ))#,
                # checkboxGroupInput("checkGroup", label = h3("Days"), 
                #                    choices = list("Monday" = 1, "Tuesday" = 2),
                #                    selected = 1)
  )
)

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

   filteredData2 <- reactive({
     coverage_data[coverage_data$Days == input$selection_days
                 & coverage_data$Manager == input$selection_manager, ]
  })
   
   pal <- colorFactor(
     palette = 'Set1',   #Dark2 is another palette option
     domain = coverage_data$Worker
   )
  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 = ~factpal(category),
        color = ~pal(coverage_data$Worker),
        weight = 1,
        radius = coverage_data$Radius,
        opacity = 0.5,
        #label = lapply(coverage_data$label, HTML),
        fillOpacity = 0.5
      )
  })  
}

shinyApp(ui,server)
2

Hi,

You were nearly there :slight_smile:
The problem was that in your leafletProxy function, you were calling the correct dataset filteredData2(), but then when assigning the colour and radius you used the original (coverage_data) dataset, which is not filtered, resulting in the weird plot. I fixed it like this:

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

#Or even shorter

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

And it works now...

Grtz,
PJ

1 Like
3

Hi Pieterjanvc,

Thank you very much! Your solution is great. It works very well for me. I really appreciate your time :slight_smile:

4

Pieterjanvc,

What if I want to allow multiple selections under each category?
I changed radioButtons to checkboxGroupInput and the inputs to input$checkdays
and input$manager in the reactive function.
For certain combinations, this works great. Example Andy_ZZZ on a wednesday shows perfectly. Andrew_XXXXX on a Monday works. Andrew_XXXXX on a Tuesday works, but Andrew_XXXXX on a Monday and Tuesday doesn't show two circles.

Any ideas?

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
                # ),
                # radioButtons(inputId = "selection_days", label = "Days:",
                #              choices = c("Monday" = "Monday",
                #                          "Tuesday" = "Tuesday",
                #                          "Wednesday" = "Wednesday"
                #              )),
                checkboxGroupInput(inputId = "checkmanager", label = h3("Manager:"),
                             choices = list("Andrew_XXXXX" = "Andrew_XXXXX",
                                         "Andy_YYYY" = "Andy_YYYY",
                                         "Robert_ZZZ" = "Robert_ZZZ"),
                             selected = 'Robert_ZZZ'),
                checkboxGroupInput(inputId = "checkdays", label = h3("Days"), 
                            choices = list("Monday" = "Monday", "Tuesday" = "Tuesday",
                                                   "Wednesday" = "Wednesday"),
                             selected = 'Wednesday')
                
  )
)

server <- function(input, output, session) { 
 
  
  filteredData2 <- reactive({
    coverage_data[coverage_data$Days == input$checkdays
                  & coverage_data$Manager == input$checkmanager, ]
  })
  
  ## 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) 
    
  })
  
  observe({
    leafletProxy("map", data = filteredData2()) %>%
      clearShapes() %>%
      addCircles(
        color = ~pal(filteredData2()$Worker),
        weight = 1,
        radius = ~filteredData2()$Radius,
        opacity = 0.5,
        #label = lapply(coverage_data$label, HTML),
        fillOpacity = 0.5
      )
  })
  
}

shinyApp(ui,server)
5

I tried this. I think it works :smiley:


# Load libraries

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)



# 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),
                selectInput(inputId = "selection_manager", label = "Manager:",
                             choices = c("Andrew_XXXXX" = "Andrew_XXXXX",
                                         "Andy_YYYY" = "Andy_YYYY",
                                         "Robert_ZZZ" = "Robert_ZZZ"
                             ), multiple = TRUE),
                selectInput(inputId = "selection_worker", label = "Worker:",
                             choices = c("A",'B','C','D','E','F'), multiple = TRUE),
                selectInput(inputId = "selection_skill", label = "Skills:",
                             choices = c("FMCC Dealer",'AFG','Ally Financial','Nissan Home',
                                         'FMCC Customer','Nissan Dealer'), multiple = TRUE),
                selectInput(inputId = 'selection_inspector', label= "Inspector:",
                             choices = c("YES", "NO"), multiple = TRUE )
  )
)



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)
1 Like
6

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.