Рисование дополнительных маркеров на листовой карте с помощью addDrawToolbar в R - PullRequest
Новая
       16

Рисование дополнительных маркеров на листовой карте с помощью addDrawToolbar в R

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

Я добавил панель инструментов на карту листовки, чтобы не-кодировщикам было проще рисовать маркеры.Для этой цели я использую следующие пакеты R: leaflet, leaflet.extras и глянцевый.

У меня есть пара вопросов:

1) Я добавил markerOptions (см. Ниже), чтобы определить значок красного листа.Насколько я знаю, у вас может быть только один вариант.Я имею в виду, что нет никакого способа позволить некодеру выбирать из пары иконок, которые вы определяете так же, как я.Можно ли как-то иначе это сделать?

2) После того, как вы щелкнули STYLE EDITOR в левом нижнем углу, чтобы отредактировать значок листа (см. Ниже), он переключится обратно к пулу значков, который у него есть, и значок листа, который вы хотите отредактировать, превратится в первыйзначок в этом пуле.

На самом деле, если есть способ добавить дополнительные значки в этот пул, как показано ниже справа, тогда мой первый вопрос будет решен.Решение не обязательно должно быть в R.

enter image description here

library(shiny)
library(leaflet)
library(leaflet.extras)


ui = fluidPage(
   tags$style(type = "text/css", "#map {height: calc(100vh - 20px)!important;}"),
   leafletOutput("map")
)

server = function(input,output,session){
   output$map = renderLeaflet(
   leaflet()%>%

   addTiles(urlTemplate = "http://mt0.google.com/vt/lyrs=m&hl=en&x={x}&y={y}&z={z}&s=Ga")%>%

   addMeasure(
    primaryLengthUnit = "kilometers",
    secondaryAreaUnit = FALSE
    )%>%

   addDrawToolbar(
    targetGroup='draw',
    editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions()),

    markerOptions = filterNULL(list(markerIcon = makeIcon(iconUrl = "http://leafletjs.com/examples/custom-icons/leaf-red.png")))) %>%
  setView(lat = 45, lng = 9, zoom = 3) %>% 

  addStyleEditor(position = "bottomleft", 
                 openOnLeafletDraw = TRUE)
  )
}

shinyApp(ui,server)

1 Ответ

0 голосов
/ 04 декабря 2018

Вы можете перечислить кучу возможных значков (здесь я выбрал font-awesome) в выбранном HTML-теге следующим образом:

1) Получить полный список значков font-awesome 

fa_list <- read_html("http://astronautweb.co/snippet/font-awesome/") %>% 
  html_nodes("span.icon-name") %>% 
  html_text()
fa_pretty <- gsub("^fa-", "", fa_list)

2) Загрузите в ui загруженные шрифты 

tags$head(
  tags$link(rel = "stylesheet", href = "https://maxcdn.bootstrapcdn.com/font-awesome/4.6.1/css/font-awesome.min.css")
)

3) Создайте виджет пользовательского интерфейса, который может отображать различные значки 

shinyWidgets::pickerInput("defaultIcon", "Default Marker", choices = fa_pretty, 
                          options = pickerOptions(liveSearch = TRUE),
                          choicesOpt = list(icon = paste("fa", fa_list), 
                                            iconBase = "fontawesome"))

Пользователь может выбрать значок, который он / она хочет, и ваша панель инструментов может уважать его, написав: 

... %>% 
  addDrawToolbar(...,
    markerOptions = list(markerIcon = makeAwesomeIcon(icon = input$defaultIcon, library = "fa"))

Однако addDrawToolbar, похоже, не очень хорошо работает с leafletProxy, так что если вы изменитемаркер-значок в пользовательском интерфейсе, он будет стереть карту листовки, и вы должны начать все сначала.Вместо этого, если вы хотите переключать значки и сохранять существующие маркеры, вы можете определить свои собственные функции для добавления маркеров.На мой взгляд, это более гибкое решение, которое по-прежнему обрабатывает все ваши запросы пользовательского интерфейса и функциональности.Полный пример ниже: 

library(shiny)
library(leaflet)
library(leaflet.extras)
library(rvest)

fa_list <- read_html("http://astronautweb.co/snippet/font-awesome/") %>% 
  html_nodes("span.icon-name") %>% 
  html_text()
fa_pretty <- gsub("^fa-", "", fa_list)
# Awesome-icon markers only support the colors below...
fa_cols <- c("red", "darkred", "lightred", "orange", "beige", "green", "darkgreen", 
             "lightgreen", "blue", "darkblue", "lightblue", "purple", "darkpurple", 
             "pink", "cadetblue", "white", "gray", "lightgray", "black")

ui <- fluidPage(
  tags$head(
    tags$link(rel = "stylesheet",
      href = "https://maxcdn.bootstrapcdn.com/font-awesome/4.6.1/css/font-awesome.min.css")
  ),
  tags$style(type = "text/css", "#map {height: calc(100vh - 20px)!important;}"),
  fluidRow(
    splitLayout(cellArgs = list(style = "overflow: visible;"),
      shinyWidgets::pickerInput("defaultIcon", "Default Marker", choices = fa_pretty, 
                                options = shinyWidgets::pickerOptions(liveSearch = TRUE),
                                choicesOpt = list(icon = paste("fa", fa_list), 
                                                  iconBase = "fontawesome")),
      colourpicker::colourInput("defaultColor", "Default icon color"),
      colourpicker::colourInput("defaultBg", "Default marker color", palette = "limited", 
                                allowedCols = fa_cols, returnName = TRUE, value = "red")
    ),
    tags$div( tags$b("Place Marker"), 
              shinyWidgets::switchInput("edit_mode", "Edit Mode", 
                                        onLabel = "Click on the map to add a marker"))
  ),
  leafletOutput("map")
)

server <- function(input,output,session){
  react_list <- reactiveValues()
  # While the user has toggled the edit-mode input, register any future map-clicks
  # as reactive values.
  observe({
    if (input$edit_mode & !isTRUE(input$map_click$.nonce == react_list$nonce)) {
      react_list$mapEditClick <- input$map_click
    }
    react_list$nonce <- input$map_click$.nonce
  })

  output$map <- renderLeaflet(
    leaflet() %>%
      addProviderTiles(providers$CartoDB.Positron) %>% 
      addMeasure(
        primaryLengthUnit = "kilometers",
        secondaryAreaUnit = FALSE) %>%
      setView(lat = 45, lng = 9, zoom = 3)
  )
  # When a user clicks on the map while being in edit-mode, place a marker with
  # the chosen icon, color and marker-color at the click coordinates.
  observeEvent(react_list$mapEditClick, {
    leafletProxy("map") %>% 
      addAwesomeMarkers(
        lng     = react_list$mapEditClick$lng, 
        lat     = react_list$mapEditClick$lat,
        layerId = as.character(react_list$mapEditClick$.nonce),
        icon    = makeAwesomeIcon(icon     = input$defaultIcon, 
                               library     = "fa", 
                               iconColor   = input$defaultColor, 
                               markerColor = input$defaultBg),
        label = "Click to delete", 
        labelOptions = labelOptions(TRUE))
  })
  # Delete the marker when it has been clicked.
  observeEvent(input$map_marker_click, {
    leafletProxy("map") %>%
      removeMarker(as.character(input$map_marker_click$id))
  })
}

shinyApp(ui,server)
...