Question

我在传单地图上添加了工具栏，以使非编码人员可以轻松地绘制标记。为此，我使用以下R包：leaflet，leaflet.extras和Shiny。

我有几个问题：

1）我添加了markerOptions（见下文）以定义红色叶子的图标。据我所知，您只能选择一种。我的意思是，没有办法让非编码者以与我相同的方式从定义的几个图标中进行选择。是否可以通过其他方式实现？

2）单击左下角的“样式编辑器”以编辑叶子图标（见下文）后，它将切换回其固有的图标池，您要编辑的叶子图标将变成该图标中的第一个图标池。

实际上，如果有一种方法可以将额外的图标添加到该池，如右下方所示，那么我的第一个问题就解决了。严格来说，该解决方案不必在R中。

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)

Answer 1

您可以通过以下方式在选择HTML标记中列出一堆可能的图标（在这里，我选择了font-awesome）：

1）获取字体真棒图标的完整列表

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）制作一个可以显示图标选择的UI小部件

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上似乎无法很好地工作，因此，如果您在UI中更改标记图标，它将擦除传单地图，您必须重新开始。相反，如果您要切换图标并保留现有标记，则可以定义自己的功能来添加标记。我认为这是一种更灵活的解决方案，仍然可以处理您的所有UI和功能请求。完整示例如下：

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)

使用R中的addDrawToolbar在传单地图上绘制额外的标记

1 个答案: