How to change Leaflet Shiny app circle color according to another variable?

Viewed 157

I'm new to Shiny. I am trying to make a layer with points of competitor pharmacies and points of my pharmacies (Tim's pharmacies). I want the colors of the points to be different (red for competition, green for mine). I thought I would need to remove pharmacy from leaflet() and make a new observe event but can't get it working. There are two data sets: the first with competitor pharmacies and the second with mine. I combined them with rbind, and thought I could specify the coloring according to a binary coded my_store column (1 for mine, 0 for competition)? Any help would be appreciated.

ID Label Lat Long State
1 Bob's 47.14032 -107.334 Montana
2 Bob's 44.57247 -116.125 Montana
3 Evan's 42.88031 -111.989 Idaho
4 Evan's 42.93041 -112.3654 Idaho
5 Silvia's 42.19124 -112.7645 Idaho
6 Evan's 45.7939 -108.768 Montana
7 John's 46.71677 -106.752 Wyoming
ID Label Lat Long State
1 Tim's 47.22632 -107.774 Montana
2 Tim's 44.67257 -116.135 Montana
3 Tim's 42.88031 -111.779 Idaho
4 Tim's 42.89041 -112.3324 Idaho
5 Tim's 42.19124 -112.7645 Idaho
6 Tim's 45.8539 -108.658 Montana
7 Tim's 46.72887 -106.7542 Wyoming
library(shiny)
library(leaflet)
library(dplyr)
library(leaflet.extras)
# install.packages("leaflet.extras")

pharmacy <- read_excel("~/pharmacy.xlsx")
My_Pharmacy <- read_excel("~/My_Pharmacy.xlsx")

all_stores <- rbind(pharmacy, My_Pharmacy)
all_stores <-
    all_stores %>%
    mutate(my_store = if_else(Label == "Tim's Pharmacy",1,0))

# Define UI 
ui <- fluidPage(

    # Application title
    titlePanel("map"),

 

        # Show a map output
        mainPanel(
           leafletOutput(outputId = "map_pharmacy"),
           selectInput(inputId = "State",
                       label = "choose a store brand",
                       choices = unique(pharmacy$State))
        )
    )


# Define server logic required 
server <- function(input, output, session) {
    filteredData <- reactive({
        pharmacy %>%
            filter(State == input$State)
    })

    output$map_pharmacy <- renderLeaflet({
        leaflet(pharmacy) %>% addTiles() %>%
            fitBounds(~min(Long), ~min(Lat), ~max(Long), ~max(Lat))
        })
    
    
    observe({
    leafletProxy("map_pharmacy", data = filteredData()) %>%
        clearShapes() %>%
        addCircles(color = "red", weight = 10)
    })
}

# Run the application 
shinyApp(ui = ui, server = server)```
1 Answers

I would create a palette pal to use for colors with addCircles.

You may want colorFactor to color based on your binary factor (my pharmacy or not my pharmacy).

You can either use a pre-defined palette (see RColorBrewer::display.brewer.all() for different palettes available). Or, you can define yourself and specifically select colors for each factor level.

Here is the complete example:

library(shiny)
library(leaflet)

pharmacy$my_store <- 0
My_Pharmacy$my_store <- 1

all_stores <- rbind(pharmacy, My_Pharmacy)

pal <- colorFactor(
  # Use a predefined palette:
  # palette = "Dark2",
  # 
  # Or specify individual colors:
  palette = c("purple", "orange"),
  domain = all_stores$my_store
)

ui <- fluidPage(
  titlePanel("map"),
  mainPanel(
    leafletOutput(outputId = "map_pharmacy"),
    selectInput(inputId = "State",
                label = "choose a store brand",
                choices = unique(all_stores$State))
  )
)

server <- function(input, output, session) {
  
  filteredData <- reactive({
    all_stores %>%
      filter(State == input$State)
  })
  
  output$map_pharmacy <- renderLeaflet({
    leaflet(filteredData()) %>% 
      addTiles() %>%
      fitBounds(~min(Long), ~min(Lat), ~max(Long), ~max(Lat))
  })
  
  observe({
    leafletProxy("map_pharmacy", data = filteredData()) %>%
      clearShapes() %>%
      addCircles(color = ~pal(my_store),
                 lng = ~Long,
                 lat = ~Lat,
                 weight = 10)
  })

}

shinyApp(ui = ui, server = server)
Related