R闪亮传单添加十字点

Question

我试图在传单地图上将点表示为十字（+）。我已经开始遵循here的示例。有两件事我想解决；

1）为什么所有点都没有显示为十字。

2）我可以修复标记大小，以便当我缩小或放大标记时保持初始创建的大小，即。不是动态标记。目前，如果我缩小它们会变大，但我想避免这种情况。

下面可重现的代码。

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)

Answer 1

尝试这个（跳过两个数据框

Poly

和

Points

以保持更短）：

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)