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的值实际上是用来制作图例形状的，因此可以添加其他样式。

填充圆圈：在上面的答案中进行了解释。
空圆圈：设置color:white;并添加border:3px solid black;以产生带有黑色轮廓的白色圆圈。
填充正方形：调整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)
        })
    }
    )

具有R传单的自定义图例-在相同的图例中具有圆形和正方形

1 个答案: