12

Each day I need to draw a path on a map and add a text like 4, 5 or 8 min. indicating how long it takes by car from the starting point to the destination (see the figure below). I thought it would be helpful to create a Shiny app using Leaflet in R (code is shown below).

I make use of addDrawToolbar from the leaflet.extras package to draw the path as can be seen on the map attached. But I do not know and could not find how to add a text in the same manner as I draw the path. The solution does not strictly need to be in R. My aim is to create an app for someone who would like to do these kinds of things and at the same time who does not know how to code.

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()),

              polylineOptions = filterNULL(list(shapeOptions = 
                    drawShapeOptions(lineJoin = "round", weight = 8))),

              circleOptions = filterNULL(list(shapeOptions = 
                    drawShapeOptions(),
                    repeatMode = F,
                    showRadius = T,
                    metric = T,
                    feet = F,
                    nautic = F))) %>%
        setView(lat = 45, lng = 9, zoom = 3) %>%
        addStyleEditor(position = "bottomleft", 
                 openOnLeafletDraw = TRUE)
 )
}

 shinyApp(ui,server)
BRCN
  • 635
  • 1
  • 12
  • 26
  • Have you considered using a popup: https://rstudio.github.io/leaflet/popups.html? You can style the text with HTML and specify the location with the latitude/longitude,... – Tonio Liebrand Oct 03 '18 at 09:20
  • I have considered your advice. Thank you very much but as explained in the question this app is to be used by non-coders and Using popups to place text on a leaflet map requires one to have coded it in advance. – BRCN Oct 05 '18 at 09:52
  • Can you just create a user entered text box and use that to populate the popup? – conv3d Oct 05 '18 at 23:29
  • You also need need lat and lon data to use popups or addLabelOnlyMarkers(this is another option), not just the text. I was meaning to achieve such an app for someone who wants to do this with the least effort possible, for someone who does not want to care about what the values of the lat and lon. – BRCN Oct 08 '18 at 11:49

1 Answers1

1

One way of doing this is to prompt the user to add text upon a double-click on the leaflet map. The double-click coordinates handles where to place the text, and the popup prompt handles what the text should say.

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

server = function(input,output,session){

  # Create reactive boolean value that indicates a double-click on the leaflet widget
  react_list <- reactiveValues(doubleClick = FALSE, lastClick = NA)
  observeEvent(input$map_click$.nonce, {
    react_list$doubleClick <- identical(react_list$lastClick, input$map_click[1:2])
    react_list$lastClick   <- input$map_click[1:2]
  })

  # Upon double-click, create pop-up prompt allowing user to enter text
  observeEvent(input$map_click[1:2], {
    if (react_list$doubleClick) {
      shinyWidgets::inputSweetAlert(session, "addText", title = "Add text:")
    }
  })

  # Upon entering the text, place the text on leaflet widget at the location of the double-click
  observeEvent(input$addText, {
    leafletProxy("map") %>% 
      addLabelOnlyMarkers(
        input$map_click$lng, input$map_click$lat, label = input$addText, 
        labelOptions = labelOptions(noHide = TRUE, direction = "right", textOnly = TRUE,
                                    textsize = "15px"))
  })

  # Clear out all text if user clears all layers via the toolbar
  observeEvent(input$map_draw_deletestop, {
    if ( length(input$map_draw_all_features$features) < 1 ) {
      leafletProxy("map") %>% clearMarkers()
    }
  })

  output$map <- renderLeaflet({
    leaflet(options = leafletOptions(doubleClickZoom = FALSE)) %>%
      addProviderTiles(providers$CartoDB.Positron) %>% 
      addMeasure(
        primaryLengthUnit = "kilometers",
        secondaryAreaUnit = FALSE) %>%
      addDrawToolbar(
        targetGroup     ='draw',
        editOptions     = editToolbarOptions(selectedPathOptions = selectedPathOptions()),
        polylineOptions = filterNULL(list(shapeOptions = drawShapeOptions(lineJoin = "round", weight = 8))),
        circleOptions   = filterNULL(list(shapeOptions = drawShapeOptions(), repeatMode = F, showRadius = T,
                                          metric = T, feet = F, nautic = F))) %>%
      setView(lng = -73.97721, lat = 40.7640, zoom = 15)
  })
}

shinyApp(ui = fluidPage( leafletOutput("map") ) , server)
Chrisss
  • 3,211
  • 1
  • 16
  • 13
  • I was going through your solution and wonder if the bit starting with "# Clear out all text if user clears all layers via the toolbar" is correctly typed. I mean in "input$mapp_draw_all_features$features": mapp or map? – BRCN Nov 18 '18 at 09:15
  • Thank you very much for the answer. Wouldn't it be great if we could delete and update the text regardless of whether you as a user clear all layers via the toolbar or not? I have been wondering if you have any suggestions for that. – BRCN Nov 19 '18 at 16:21
  • 1
    Yes, there are ways. This was the simplest solution to this specific question. As for deleting text, you'd probably want to keep a reactive list of all the text you've added to the map (much like `leaflet.extras` does with `input$map_draw_all_features`). You could display this list as a table with `DT`. Observe when a row is clicked (`input$tableId_cell_clicked`), then delete the corresponding text from the widget with `leaflet::removeMarker`. – Chrisss Nov 19 '18 at 18:47
  • I have asked another question which is associated to this one: https://stackoverflow.com/questions/53650039/how-to-save-a-leaflet-map-with-drawn-shapes-points-on-it-in-shiny. Shortly, I want to save the map with the drawn shapes, lines, and the added texts as a pdf. Maybe, you can give me a hint. – BRCN Dec 06 '18 at 11:12