r - 带有 R 传单的自定义图例 - 相同情节图例中的圆形和正方形

Question

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

到目前为止，我已经使用了上一篇文章中的建议，并在我 Shiny 的 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)
        })
    }
    )