Search code examples
rshinyr-leaflet

Custom legend with R leaflet- circles and squares in same plot legends


I would like to create a leaflet map that has both circles and squares in the same leaflet plot legend.

I have so far used the suggestion found in a previous post and added the following code in my shiny UI code.

   tags$style(type = "text/css", "html, body   {width:100%;height:100%}",
                       ".leaflet .legend i{
  position: 'topleft';
  border-radius: 50%;
  width: 10px;
  height: 10px;
  margin-top: 4px;
  }
")

In this way I have although only circles in the legend while I would like to have 3 types of legends: 1) filled circles, 2) empty circles (only border) and 3) filled squared.

How could I make such a legend using leaflet for R?


Solution

  • The following code is based entirely on this answer, with a few modifications to make "empty" circles and "squares". As explained in that post, the values given to addLegend are used literally to make legend shapes, so additional styling can be added.

    1. Filled circles: explained in the above answer.

    2. Empty circles: set color:white; and add border:3px solid black; to produce a white circle with a black outline.

    3. Filled squares: Adjust border-radius. Circles have 50% radius, whereas squares have 0% radius.

    Try this:

    library(shiny)
    library(leaflet)
    
    #create data
    Points<-data.frame(x=runif(10,20,21), y=runif(10,0,1), var=rep(c(5,10),5))
    map = leaflet() %>% addTiles()
    
    # Set up shiny app
    shinyApp(
        ui = bootstrapPage(
            tags$style(type = "text/css", 
                       "html, body {width:100%;height:100%}",
                       ".leaflet .legend i{
                       width: 10px;
                       height: 10px;
                       margin-top: 4px;
                       }
                       "
                       ),
            leafletOutput("myMap", width = "100%", height = "100%")
            ),
    
        server = function(input, output){
    
            # set legend features
            colors <- c("red", "white", "blue", "white", "blue", "red")
            labels <- c("filled_square", "empty_square", "big_square", "empty_circle", "filled_circle", "big_circle")
            sizes <- c(10, 20, 30, 10, 20, 30)
            shapes <- c("square", "square", "square", "circle", "circle", "circle")
            borders <- c("red", "blue", "black", "blue", "blue", "black")
    
            addLegendCustom <- function(map, colors, labels, sizes, shapes, borders, opacity = 0.5){
    
                make_shapes <- function(colors, sizes, borders, shapes) {
                    shapes <- gsub("circle", "50%", shapes)
                    shapes <- gsub("square", "0%", shapes)
                    paste0(colors, "; width:", sizes, "px; height:", sizes, "px; border:3px solid ", borders, "; border-radius:", shapes)
                }
                make_labels <- function(sizes, labels) {
                    paste0("<div style='display: inline-block;height: ", 
                           sizes, "px;margin-top: 4px;line-height: ", 
                           sizes, "px;'>", labels, "</div>")
                }
    
                legend_colors <- make_shapes(colors, sizes, borders, shapes)
                legend_labels <- make_labels(sizes, labels)
    
                return(addLegend(map, colors = legend_colors, labels = legend_labels, opacity = opacity))
            }
    
            output$myMap = renderLeaflet({map %>% 
                    addCircleMarkers(Points$x,Points$y,radius=Points$var) %>%
                    addLegendCustom(colors, labels, sizes, shapes, borders)
            })
        }
        )
    

    enter image description here