Search code examples
rshinyr-leaflet

R shiny leaflet add crosses for points


I am trying to represent points as a cross (+) on a leaflet map. I have started following the example here. There are two things I would like to sort out;

1) why all the points are not showing up as crosses.

2) Can I fix the marker size, so that when I zoom out or in the markers stay the size of the initial creation, ie. not dynamic markers. Currently if I zoom out they get large but I want to avoid that.

Reproducible code below.

Poly = data.frame(Strat = c("A","A","A","A","A","B","B","B","B","B"), long = c(174.5012, 174.5026, 174.5026, 174.5014,174.5012,174.5012 ,174.5020, 174.5020,174.5012,174.5012),lat = c(-35.84014, -35.84018, -35.84137,-35.84138,-35.84014,-35.84014,-35.84014,-35.84197,-35.84197,-35.84014))
Points = data.frame(long = c(174.5014 ,174.5017, 174.5021, 174.5023, 174.5020, 174.5017 ,174.5021 ,174.5017, 174.5021, 174.5019), lat = c(-35.84187, -35.84165, -35.84220 ,-35.84121, -35.84133, -35.84034, -35.84082, -35.84101, -35.84112, -35.84084))


library('leaflet')
library('shiny')
library('webshot')
library('htmlwidgets')


# A function to create png images for each shape and color 
# for the leaflet maps
pchIcons = function(pch = 1, width = 30, height = 30, bg = "transparent", col = "black", ...) {
  n = length(pch)
  files = character(n)
  # create a sequence of png images
  for (i in seq_len(n)) {
    f = tempfile(fileext = '.png')
    png(f, width = width, height = height, bg = bg)
    par(mar = c(0, 0, 0, 0))
    plot.new()
    points(.5, .5, pch = pch[i], col = col[i], cex = min(width, height) / 8, ...)
    dev.off()
    files[i] = f
  }
  return(list("iconUrl" = files, "iconWidth" = width, "iconHeight" = height))
}
##### UI
ui <- fluidPage(
   mainPanel(leafletOutput("map"))
)
##### Server
server = function(input, output){
  output$map <- renderLeaflet({
    mymap()      
  })

  mymap <- reactive({
     leaflet() %>% addTiles(urlTemplate = "http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png", attribution = NULL, layerId = NULL, group = NULL, options = tileOptions()) %>%  
     clearShapes() %>%
     clearMarkers() %>%      
     fitBounds(lng1 = 174.5042, lat1= -35.83814,lng2= 174.5001, lat2 = -35.8424) 
  })   

  myfun <- function(map) {
      print("adding points")
      map %>% clearShapes() %>%
      clearControls() %>% 
      clearMarkers() %>% 
      addCircles(lng = Points$long, lat = Points$lat, color = "blue",fillOpacity = 1,radius = 1) %>%
      addMarkers(lng = Points$long, lat = Points$lat,icon = makeIcon(iconUrl = pchIcons(pch= 3,col="blue", height = 20, width = 20),popupAnchorX = 10, popupAnchorY = 0))            
   }

  AddStrataPoly <- function(map) {
      print("adding polygons")    
      for(i in 1:length(unique(Poly$Strat))) {
        map <- map %>% addPolygons(lng = Poly[Poly$Strat == unique(Poly$Strat)[i],]$long, lat = Poly[Poly$Strat == unique(Poly$Strat)[i],]$lat, layerId = unique(Poly$Strat)[i], color = 'gray60', options = list(fillOpacity = 0.1))
      } 
      map
    }

  observe({
    leafletProxy("map") %>% myfun() %>% AddStrataPoly() 
  })

  newmap <- reactive({
    mymap() %>% myfun() %>% AddStrataPoly()
  })
}
shinyApp(ui, server)

Solution

  • Try this (skipping the two dataframes Poly and Points to keep it shorter):

    library('leaflet')
    library('shiny')
    library('webshot')
    library('htmlwidgets')
    
    # A function to create png images for each shape and color
    # for the leaflet maps
    pchIcons = function(pch = 3,
                        width = 30,
                        height = 30,
                        bg = "transparent",
                        col = "black",
                        ...) {
      n = length(pch)
      files = character(n)
      # create a sequence of png images
      for (i in seq_len(n)) {
        f = tempfile(fileext = '.png')
        png(f,
            width = width,
            height = height,
            bg = bg)
        par(mar = c(0, 0, 0, 0))
        plot.new()
        points(
          .5,
          .5,
          pch = pch[i],
          col = col[i],
          cex = min(width, height) / 8,
          ...
        )
        dev.off()
        files[i] = f
      }
      return(list(iconUrl = files, iconWidth = width, iconHeight = height))
    }
    
    ##### UI
    ui <- fluidPage(mainPanel(leafletOutput("map")))
    
    ##### Server
    server = function(input, output) {
      output$map <- renderLeaflet({
        mymap()
      })
    
      mymap <- reactive({
        leaflet() %>% addTiles(
          urlTemplate = "http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png",
          attribution = NULL,
          layerId = NULL,
          group = NULL,
          options = tileOptions()
        ) %>%
          clearShapes() %>%
          clearMarkers() %>%
          fitBounds(
            lng1 = 174.5042,
            lat1 = -35.83814,
            lng2 = 174.5001,
            lat2 = -35.8424
          )
      })
    
      myfun <- function(map) {
        print("adding points")
        map %>% clearShapes() %>%
          clearControls() %>%
          clearMarkers() %>%
          addCircles(
            lng = Points$long,
            lat = Points$lat,
            color = "blue",
            fillOpacity = 1,
            radius = 1
          ) %>%
          addMarkers(
            lng = Points$long,
            lat = Points$lat,
            icon = makeIcon(
              iconUrl = pchIcons()$iconUrl,
              iconWidth = pchIcons()$iconWidth,
              iconHeight = pchIcons()$iconHeight,
              popupAnchorX = 10,
              popupAnchorY = 0
            )
          )
      }
    
      AddStrataPoly <- function(map) {
        print("adding polygons")
        for (i in 1:length(unique(Poly$Strat))) {
          map <-
            map %>% addPolygons(
              lng = Poly[Poly$Strat == unique(Poly$Strat)[i], ]$long,
              lat = Poly[Poly$Strat == unique(Poly$Strat)[i], ]$lat,
              layerId = unique(Poly$Strat)[i],
              color = 'gray60',
              options = list(fillOpacity = 0.1)
            )
        }
        map
      }
    
      observe({
        leafletProxy("map") %>% myfun() %>% AddStrataPoly()
      })
    
      newmap <- reactive({
        mymap() %>% myfun() %>% AddStrataPoly()
      })
    }
    shinyApp(ui, server)