如何在ggplot map中添加比例尺

Question

我有一个这样的简单地图：

library(maps)
library(ggplot2)    
rs=map("world", col="gray80", 
          xlim=c(32.002755, 44.283487),
          ylim=c(12.075434, 30.211327),
          resolution=0, bg="white", lty=1, lwd=2, fill=T)
redsea= map_data(rs)

然后我用ggplot2绘制它：

ggplot()+
   geom_polygon(data=redsea, 
          aes(long,lat, group=group, label=redsea$region), color="black", fill="gray80")+
   coord_fixed(xlim=c(32.002755, 44.283487),ylim=c(12.075434, 30.211327), ratio=1.3)+
   theme_bw()

地图看起来很适合我，但我需要添加比例尺。我使用以下代码来执行此操作：

ggplot(....)+scalebar(39.392287,27.903255, dist=1000, location="topright", st.size=2)

这不起作用，并给我一个警告信息，有时抱怨该功能不存在。有人建议如何在此地图中添加比例尺和北向箭头？

Answer 1

当我添加所有函数和所有必需的包，即来自install.packages("ggplot2", "grid", "maptools", "maps", dependencies = TRUE)的the linked blog post时，它适用于我（参见下面的代码）

ggplot(…) + scaleBar(lon = 38.5, lat = 28, distanceLon = 200, distanceLat = 100, distanceLegend = 200, dist.unit = "km", orientation = FALSE)

我的所有代码是否应该构成我的回复的博客文章？

Answer 2

在this blog entry之后，我也使用了@Eric Fail提供的方法。然而，我添加了一些额外的噱头，比如围绕刻度的盒子以及改变北箭头颜色的可能性。这可能对绘制ggmap(get_map())基本地图有用：

library(maps)
library(maptools)
library(ggplot2)
library(grid)

#
# Result #
#--------#
# Return a list whose elements are :
#   - rectangle : a data.frame containing the coordinates to draw the first rectangle ;
#   - rectangle2 : a data.frame containing the coordinates to draw the second rectangle ;
#   - legend : a data.frame containing the coordinates of the legend texts, and the texts as well.
#
# Arguments : #
#-------------#
# lon, lat : longitude and latitude of the bottom left point of the first rectangle to draw ;
# distanceLon : length of each rectangle ;
# distanceLat : width of each rectangle ;
# distanceLegend : distance between rectangles and legend texts ;
# dist.units : units of distance "km" (kilometers) (default), "nm" (nautical miles), "mi" (statute miles).
createScaleBar <- function(lon,lat,distanceLon,distanceLat,distanceLegend, dist.units = "km"){
  # First rectangle
  bottomRight <- gcDestination(lon = lon, lat = lat, bearing = 90, dist = distanceLon, dist.units = dist.units, model = "WGS84")

  topLeft <- gcDestination(lon = lon, lat = lat, bearing = 0, dist = distanceLat, dist.units = dist.units, model = "WGS84")
  rectangle <- cbind(lon=c(lon, lon, bottomRight[1,"long"], bottomRight[1,"long"], lon),
                     lat = c(lat, topLeft[1,"lat"], topLeft[1,"lat"],lat, lat))
  rectangle <- data.frame(rectangle, stringsAsFactors = FALSE)

  # Second rectangle t right of the first rectangle
  bottomRight2 <- gcDestination(lon = lon, lat = lat, bearing = 90, dist = distanceLon*2, dist.units = dist.units, model = "WGS84")
  rectangle2 <- cbind(lon = c(bottomRight[1,"long"], bottomRight[1,"long"], bottomRight2[1,"long"], bottomRight2[1,"long"], bottomRight[1,"long"]),
                      lat=c(lat, topLeft[1,"lat"], topLeft[1,"lat"], lat, lat))
  rectangle2 <- data.frame(rectangle2, stringsAsFactors = FALSE)

  # Now let's deal with the text
  onTop <- gcDestination(lon = lon, lat = lat, bearing = 0, dist = distanceLegend, dist.units = dist.units, model = "WGS84")
  onTop2 <- onTop3 <- onTop
  onTop2[1,"long"] <- bottomRight[1,"long"]
  onTop3[1,"long"] <- bottomRight2[1,"long"]

  legend <- rbind(onTop, onTop2, onTop3)
  legend <- data.frame(cbind(legend, text = c(0, distanceLon, distanceLon*2)), stringsAsFactors = FALSE, row.names = NULL)
  return(list(rectangle = rectangle, rectangle2 = rectangle2, legend = legend))
}


#
# Result #
#--------#
# Returns a list containing :
#   - res : coordinates to draw an arrow ;
#   - coordinates of the middle of the arrow (where the "N" will be plotted).
#
# Arguments : #
#-------------#
# scaleBar : result of createScaleBar() ;
# length : desired length of the arrow ;
# distance : distance between legend rectangles and the bottom of the arrow ;
# dist.units : units of distance "km" (kilometers) (default), "nm" (nautical miles), "mi" (statute miles).
createOrientationArrow <- function(scaleBar, length, distance = 1, dist.units = "km"){
  lon <- scaleBar$rectangle2[1,1]
  lat <- scaleBar$rectangle2[1,2]

  # Bottom point of the arrow
  begPoint <- gcDestination(lon = lon, lat = lat, bearing = 0, dist = distance, dist.units = dist.units, model = "WGS84")
  lon <- begPoint[1,"long"]
  lat <- begPoint[1,"lat"]

  # Let us create the endpoint
  onTop <- gcDestination(lon = lon, lat = lat, bearing = 0, dist = length, dist.units = dist.units, model = "WGS84")

  leftArrow <- gcDestination(lon = onTop[1,"long"], lat = onTop[1,"lat"], bearing = 225, dist = length/5, dist.units = dist.units, model = "WGS84")

  rightArrow <- gcDestination(lon = onTop[1,"long"], lat = onTop[1,"lat"], bearing = 135, dist = length/5, dist.units = dist.units, model = "WGS84")

  res <- rbind(
    cbind(x = lon, y = lat, xend = onTop[1,"long"], yend = onTop[1,"lat"]),
    cbind(x = leftArrow[1,"long"], y = leftArrow[1,"lat"], xend = onTop[1,"long"], yend = onTop[1,"lat"]),
    cbind(x = rightArrow[1,"long"], y = rightArrow[1,"lat"], xend = onTop[1,"long"], yend = onTop[1,"lat"]))

  res <- as.data.frame(res, stringsAsFactors = FALSE)

  # Coordinates from which "N" will be plotted
  coordsN <- cbind(x = lon, y = (lat + onTop[1,"lat"])/2)

  return(list(res = res, coordsN = coordsN))
}
#
# Result #
#--------#
# This function enables to draw a scale bar on a ggplot object, and optionally an orientation arrow #
# Arguments : #
#-------------#
# lon, lat : longitude and latitude of the bottom left point of the first rectangle to draw ;
# distanceLon : length of each rectangle ;
# distanceLat : width of each rectangle ;
# distanceLegend : distance between rectangles and legend texts ;
# dist.units : units of distance "km" (kilometers) (by default), "nm" (nautical miles), "mi" (statute miles) ;
# rec.fill, rec2.fill : filling colour of the rectangles (default to white, and black, resp.);
# rec.colour, rec2.colour : colour of the rectangles (default to black for both);
# legend.colour : legend colour (default to black);
# legend.size : legend size (default to 3);
# orientation : (boolean) if TRUE (default), adds an orientation arrow to the plot ;
# arrow.length : length of the arrow (default to 500 km) ;
# arrow.distance : distance between the scale bar and the bottom of the arrow (default to 300 km) ;
# arrow.North.size : size of the "N" letter (default to 6).
res <- c()
scaleBar <- function(lon, lat, distanceLon, distanceLat, distanceLegend, dist.unit = "km", rec.fill = "white", rec.colour = "black", rec2.fill = "black", rec2.colour = "black", legend.colour = "black", legend.size = 3, orientation = TRUE, arrow.length = 500, arrow.distance = 300, arrow.North.size = 6, arrow.color = "black", box = TRUE, box.line.color = "black", box.fill.color = "white", box.offset = 1){
  if (box){# Add a background box for better visualization on top of a base map
    topLeft <- gcDestination(lon = lon, lat = lat, bearing = 0, dist = distanceLat, dist.units = dist.unit, model = "WGS84")
    bottomRight <- gcDestination(lon = lon, lat = lat, bearing = 90, dist = distanceLon*2, dist.units = dist.unit, model = "WGS84")

    boxTopLeft <- gcDestination(lon = topLeft[1,"long"], lat = topLeft[1,"lat"], bearing = 315, dist = box.offset, dist.units = dist.unit, model = "WGS84")
    boxTopRight <- gcDestination(lon = bottomRight[1,"long"], lat = topLeft[1,"lat"], bearing = 45, dist = box.offset, dist.units = dist.unit, model = "WGS84")
    boxBottomRight <- gcDestination(lon = bottomRight[1,"long"], lat = bottomRight[1,"lat"], bearing = 135, dist = box.offset, dist.units = dist.unit, model = "WGS84")
    boxBottomLeft <- gcDestination(lon = topLeft[1,"long"], lat = bottomRight[1,"lat"], bearing = 225, dist = box.offset, dist.units = dist.unit, model = "WGS84")
    bg <- cbind(lon = c(boxTopLeft[1,"long"], boxTopRight[1,"long"], boxBottomRight[1,"long"], boxBottomLeft[1,"long"], boxTopLeft[1,"long"]),
                lat = c(boxTopLeft[1, "lat"], boxTopRight[1, "lat"], boxBottomRight[1, "lat"], boxBottomLeft[1, "lat"], boxTopLeft[1, "lat"]))
    bgdf <- data.frame(bg, stringsAsFactors = FALSE)
    bg <- geom_polygon(data = bgdf, aes(x = lon, y = lat), fill = box.fill.color, colour = box.line.color, size = 0.2)
    res <- c(res, bg)
  }

  laScaleBar <- createScaleBar(lon = lon, lat = lat, distanceLon = distanceLon, distanceLat = distanceLat, distanceLegend = distanceLegend, dist.unit = dist.unit)
  # First rectangle
  rectangle1 <- geom_polygon(data = laScaleBar$rectangle, aes(x = lon, y = lat), fill = rec.fill, colour = rec.colour)

  # Second rectangle
  rectangle2 <- geom_polygon(data = laScaleBar$rectangle2, aes(x = lon, y = lat), fill = rec2.fill, colour = rec2.colour)

  # Legend
  scaleBarLegend <- annotate("text", label = paste(laScaleBar$legend[,"text"], dist.unit, sep=""), x = laScaleBar$legend[,"long"], y = laScaleBar$legend[,"lat"], size = legend.size, colour = legend.colour)

  res <- c(res, list(rectangle1, rectangle2, scaleBarLegend))

  if(orientation){# Add an arrow pointing North
    coordsArrow <- createOrientationArrow(scaleBar = laScaleBar, length = arrow.length, distance = arrow.distance, dist.unit = dist.unit)
    arrow <- list(geom_segment(data = coordsArrow$res, aes(x = x, y = y, xend = xend, yend = yend), color = arrow.color), annotate("text", label = "N", x = coordsArrow$coordsN[1,"x"], y = coordsArrow$coordsN[1,"y"], size = arrow.North.size, colour = arrow.color))
    res <- c(res, arrow)
  }

  return(res)
}

你插入scaleBar()的所有距离都在“dist.units”中，如“km”。 Lat和Long定义位置，并且必须在mapUnits中（例如，在WGS84中时为十进制度数）。 location = "topright"不适用于此功能。

Answer 3

您还应该查看ggsn包

library(ggsn); library(sf)
dsn <- system.file('extdata', package = 'ggsn')

# Map in geographic coordinates
map <- st_read(dsn, 'sp', quiet = TRUE)

 ggm1 <- ggplot(map, aes(fill = nots)) +
    geom_sf() +
    scale_fill_brewer(name = 'Animal abuse\nnotifications', palette = 8)

ggm1 +
        blank() +
        north(map) +
        scalebar(map, dist = 5, dd2km = TRUE, model = 'WGS84')