带有 R 传单的自定义图例 - 同一图例中的圆形和正方形

Question

我想创建一个传单地图，在同一个传单图图例中同时包含圆形和正方形。

到目前为止，我已经使用了上一篇文章中的建议，并在我闪亮的 UI 代码中添加了以下代码。

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

通过这种方式，虽然图例中只有圆圈，但我想要 3 种类型的图例：1）实心圆圈，2）空心圆圈（仅边框）和 3）实心正方形。

如何使用 R 的传单制作这样的图例？

Answer 1

以下代码完全基于this答案，进行了一些修改以制作“空”圆圈和“正方形”。正如该文章中所解释的，赋予

addLegend

的值实际上用于制作图例形状，因此可以添加额外的样式。

1. 实心圆圈：在上面的答案中进行了解释。

2. 空圆圈：设置

   color:white;

   并添加

   border:3px solid black;

   以产生带有黑色轮廓的白色圆圈。

3. 实心方块：调整

   border-radius

   。圆形的半径为 50%，而正方形的半径为 0%。

试试这个：

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