CODEWITHSUNDEEP
rshinyr-leaflet
Logowilliams
Logowilliams

Reputation: 98

Shiny Leaflet R Won't Correctly Change Color of Circle Markers

I am trying to make a leaflet map in shiny so that the user is able to select a variable and the map will color the markers according to the variable that the user has selected. I am able to color the markers but unfortunately the colors aren't corresponding to the selected variable. So, for example, if the user chooses to color by "Year" all points from the same year should be colored the same, but this is not the case. What am I missing?

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

SampleData <- data.frame(year = c('2017', '2018', '2017', '2020'),
                         lon = c(38.62893, 38.62681, 38.62797, 38.62972),
                         lat = c(-90.26233, -90.25272, -90.26232, -90.25703),
                         month = c('January', 'February', 'March', 'April'),
                         new_use = c('Industrial', 'Institutional', 'Commercial', 'Residential'))

vars <- c(
  "Color by Year" = "year",
  "Color by Month" = "month",
  "Color by Use" = "new_use"
)

ui <- bootstrapPage(
    tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
    leafletOutput("map", width = "100%", height = "100%"),
    absolutePanel(top = 10, right = 10,
                  pickerInput(inputId = "month", 
                              label = "Select Month:", 
                              choices = sort(unique(SampleData$month)), 
                              multiple = TRUE,
                              selected = sort(unique(SampleData$month)),
                              options = list(
                                `actions-box` = TRUE, 
                                `selected-text-format` = paste0("count > ", length(sort(unique(SampleData$month))) -1), `count-selected-text` = "All Months")),
                  pickerInput(inputId = "year", 
                              label = "Select Year:", 
                              choices = sort(unique(SampleData$year)), 
                              multiple = TRUE,
                              selected = sort(unique(SampleData$year)),
                              options = list(
                                `actions-box` = TRUE, 
                                `selected-text-format` = paste0("count > ", length(sort(unique(SampleData$year))) -1), `count-selected-text` = "All Years")),
                  pickerInput(inputId = "new_use", 
                              label = "Select Permit Use:", 
                              choices = sort(unique(SampleData$new_use)), 
                              multiple = TRUE,
                              selected = sort(unique(SampleData$new_use)),
                              options = list(
                                `actions-box` = TRUE, 
                                `selected-text-format` = paste0("count > ", length(sort(unique(SampleData$new_use))) -1), `count-selected-text` = "All Permit Types")),
                  selectInput(inputId = "color",
                              label = "Select a Color Scheme:", 
                              choices = vars)
    )
)

server <- function(input, output, session) {
    
    output$map <- renderLeaflet({
        leaflet() %>% 
            setView(lng = -90.1994, lat = 38.6270, zoom = 10)%>%
            addProviderTiles(providers$CartoDB.Positron)
    })
    
    # Reactive expression for the data subsetted to what the user selected
    filteredData <- reactive({
        dplyr::filter(SampleData, year %in% input$year & new_use %in% input$new_use & month %in% input$month)
    })
  
observe({
  
  colorBy <- input$color

    if (colorBy == "year") {
      colorData <- sort(unique(SampleData$year))
      pal <- colorFactor("Set1", colorData)
     } 
    if (colorBy == "month") {
      colorData <- sort(unique(SampleData$month))
      pal <- colorFactor("Set1", colorData)
    }
    if (colorBy == "dayNight") {
      colorData <- sort(unique(tot$dayNight))
      pal <- colorFactor("Set1", colorData)
    }
  
        leafletProxy("map") %>%
            clearShapes() %>%
            addCircleMarkers(data = filteredData(), 
             ~lat, ~lon, color = pal(colorData), popup = paste("<b>Year:</b> ", filteredData()$year, "<br>",
                  "<b>Permit Type:</b> ", filteredData()$new_use, "<br>")) %>%
       addLegend("bottomright", pal=pal, values=colorData, title=colorBy,
         layerId="colorLegend")
    })
}    
    


shinyApp(ui, server)

Upvotes: 1

Views: 779

Answers (1)

diaspv
diaspv

Reputation: 111

colorFactor needs categorical data

library(shiny)
library(shinyWidgets)
library(dplyr)
library(leaflet)
library(RColorBrewer)

SampleData <- data.frame(year = c('2017', '2018', '2017', '2020', '2018', '2018', '2017'),
                         lon = c(38.62893, 38.62681, 38.62797, 38.62972, 38.624, 38.6245, 38.6252),
                         lat = c(-90.26233, -90.25272, -90.26232, -90.25703, -90.264, -90.265, -90.266),
                         month = c('January', 'February', 'March', 'April', 'February', 'March', 'April'),
                         new_use = c('Industrial', 'Institutional', 'Commercial', 'Residential',  'Institutional', 'Commercial', 'Residential'))

vars <- c(
  "Color by Year" = "year",
  "Color by Month" = "month",
  "Color by Use" = "new_use"
)

ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width = "100%", height = "100%"),
  absolutePanel(top = 10, right = 10,
                pickerInput(inputId = "month", 
                            label = "Select Month:", 
                            choices = sort(unique(SampleData$month)), 
                            multiple = TRUE,
                            selected = sort(unique(SampleData$month)),
                            options = list(
                              `actions-box` = TRUE, 
                              `selected-text-format` = paste0("count > ", length(sort(unique(SampleData$month))) -1), `count-selected-text` = "All Months")),
                pickerInput(inputId = "year", 
                            label = "Select Year:", 
                            choices = sort(unique(SampleData$year)), 
                            multiple = TRUE,
                            selected = sort(unique(SampleData$year)),
                            options = list(
                              `actions-box` = TRUE, 
                              `selected-text-format` = paste0("count > ", length(sort(unique(SampleData$year))) -1), `count-selected-text` = "All Years")),
                pickerInput(inputId = "new_use", 
                            label = "Select Permit Use:", 
                            choices = sort(unique(SampleData$new_use)), 
                            multiple = TRUE,
                            selected = sort(unique(SampleData$new_use)),
                            options = list(
                              `actions-box` = TRUE, 
                              `selected-text-format` = paste0("count > ", length(sort(unique(SampleData$new_use))) -1), `count-selected-text` = "All Permit Types")),
                selectInput(inputId = "color",
                            label = "Select a Color Scheme:", 
                            choices = vars)
  )
)

server <- function(input, output, session) {
  
  output$map <- renderLeaflet({
    leaflet() %>% 
      setView(lng = -90.1994, lat = 38.6270, zoom = 10)%>%
      addProviderTiles(providers$CartoDB.Positron)
  })
  
  # Reactive expression for the data subsetted to what the user selected
  filteredData <- reactive({
    dplyr::filter(SampleData, year %in% input$year & new_use %in% input$new_use & month %in% input$month)
  })
  
  observe({
    
    colorBy <- input$color
    
    if (colorBy == "year") {
      colorData <- factor(SampleData$year)
      pal <- colorFactor(palette = "Set1", levels = levels(colorData))
    } 
    if (colorBy == "month") {
      colorData <- factor(SampleData$month)
      pal <- colorFactor(palette = "Set1", levels = levels(colorData))
    }
    if (colorBy == "dayNight") {
      colorData <- factor(tot$dayNight)
      pal <- colorFactor(palette = "Set1", levels = levels(colorData))
    }
    
    leafletProxy("map") %>%
      clearShapes() %>%
      addCircleMarkers(data = filteredData(), 
                       ~lat, ~lon, color = ~pal(colorData), popup = paste("<b>Year:</b> ", filteredData()$year, "<br>",
                                                                         "<b>Permit Type:</b> ", filteredData()$new_use, "<br>")) %>%
      addLegend("bottomright", pal = pal, values = levels(colorData), title = colorBy,
                layerId = "colorLegend")
  })
}    



shinyApp(ui, server)

Upvotes: 1

Related Questions