Пользовательская легенда с буклетами R и кругами в тех же сюжетных легендах - PullRequest
Новая
       11

Пользовательская легенда с буклетами R и кругами в тех же сюжетных легендах

0 голосов
/ 15 октября 2018

Я хотел бы создать листовую карту, в которой есть и круги, и квадраты в одной и той же легенде сюжета.

До сих пор я использовал предложение, найденное в предыдущем посте, и добавил следующий код в свой блестящийКод пользовательского интерфейса. 

   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?

1 Ответ

0 голосов
/ 19 октября 2018

Следующий код полностью основан на этом ответе, с некоторыми изменениями для создания "пустых" кругов и "квадратов".Как объясняется в этом посте, значения, присвоенные 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)
        })
    }
    )

enter image description here

...