Drawing extra markers on a leaflet map with addDrawToolbar in R

Question

I have added a Toolbar on a leaflet map to make it easy for non-coders to draw markers. For this purpose, I make use of the following R packages: leaflet, leaflet.extras, and shiny.

I have a couple of questions:

1) I have added markerOptions (see below) to define an icon of the red leaf. As far as I experienced, you can only have one option. I mean there is no way to let a non-coder to choose from a couple of icons you define in the same way as I did. Is it possible to make it happen in some other way?

2) Once you have clicked STYLE EDITOR on the bottom left to edit the leaf icon (see below), it switches back to the icons pool it has intrinsically and the leaf icon you mean to edit turn into the first icon in this pool.

Actually, if there is a way to add extras icons into this pool seen below on the right, then my first question gets solved. The solution does not strictly need to be in 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)

Chrisss Chrisss · Accepted Answer · 2018-12-04T15:39:06

You can list a bunch of possible icons (here I chose font-awesome) in a select HTML tag in the following way:

1) Get the full list of font-awesome icons

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

2) Within your ui, load the font-awesome fonts

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

3) Make a UI widget that can display a choice of icons

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

The user can select the icon he/she wants and your toolbar can respect it by writing:

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

However, addDrawToolbar doesn't seem to work very well with leafletProxy, so if you change the marker-icon in the UI, it will wipe the leaflet map and you have to start all over. Instead if you want to switch icons and keep existing markers, you can define your own functionality to add markers. In my opinion this is a more flexible solution that still handles all your UI and functionality requests. Full example below:

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)

Drawing extra markers on a leaflet map with addDrawToolbar in R

1 Answers