简体   繁体   中英

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?

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

在此处输入图片说明

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM