CODEWITHSUNDEEP
rshinyr-leaflet
dsgeek
dsgeek

Reputation: 3

Getting the number of circles correct in Shiny

I am building an app that displays circles for different coordinates.

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. So why are the 4 extra circles showing up?

I added two radioButtons and I want to display the intersection of the different variables on my map and looked at

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

Upvotes: 0

Views: 46

Answers (1)

Shree
Shree

Reputation: 11150

Here's the change you need -

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

Also, leaflet(coverage_data) is not needed in output$map; simply leaflet() will do since you are not plotting anything there.

Upvotes: 0

Related Questions