【问题标题】:Adding scale bar to ggplot map向ggplot地图添加比例尺
【发布时间】:2013-06-13 14:43:50
【问题描述】:

我在ggplot2制作了这张地图:

library(maptools); library(ggplot2)
data(wrld_simpl)
world <- fortify(wrld_simpl)
worldUk <- subset(world, id=="GBR")
ggplot() +
geom_path(aes(long, lat, group=group), data=worldUk, color="black", fill=NA) +
  coord_equal()

使用 Photoshop,我在地图上添加了比例尺。如何使用ggplot2 添加类似的比例尺?这篇文章添加了一个比例尺,但该比例尺不指距离:scale bar and north arrow on map-ggplot2

【问题讨论】:

  • 你测试过这个吗:stackoverflow.com/questions/15486551/… ?
  • 是的 - 请参阅问题底部的链接
  • 只是一个观察 - 您需要非常小心地将比例尺放在覆盖大纬度范围的图上。根据您选择的投影,比例尺可能仅在图像的一部分中有效。所以这并不像添加比例尺那么简单......
  • 从 Osmo Salomaa 找到了这个功能,它对我有用(使用 UTM CRS)。 groups.google.com/forum/#!topic/ggplot2/klHWR0VrCYQ

标签: r map ggplot2 spatial


【解决方案1】:

我建议使用 annotate(),它可以让您在绘图区域中绘制适当长度的线段。然后,您可以在上方/下方添加文本作为标签。

【讨论】:

    【解决方案2】:

    我在http://editerna.free.fr/wp/?p=76 上找到了这个答案,我发现它很简单而且效果很好,所以我必须分享它!

    很简单,先将下面的代码粘贴到你的控制台中(无需编辑)

     library(maps) 
     library(maptools)  
     library(ggplot2)  
     library(grid)  
     #Then, we need a function to get the scale bar coordinates:
    
     #
     # 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)) } We also need a function to obtain the coordinates of the North arrow:
    
     #
     # 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)) } The last function enables the user to draw the elements:
    
     #
     # 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). 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){
         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 <- 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)), annotate("text", label = "N", x =
     coordsArrow$coordsN[1,"x"], y = coordsArrow$coordsN[1,"y"], size =
     arrow.North.size, colour = "black"))
             res <- c(res, arrow)
         }
         return(res) }
    

    现在,绘制地图!

    首先创建您的 ggplot 地图,然后使用 «+ » 符号将比例尺添加为额外图层:

     your_ggplot_object -> your_ggplot_object + scaleBar(lon = -130, lat = 26, distanceLon = 500,
     distanceLat = 100, distanceLegend = 200, dist.unit = "km")
    

    在上面的示例中,我调用了 «scaleBar» 函数,并为参数指定了一些值。例如,lon = -130, lat = 26 表示我希望矩形的左下角位于 (-130,26)。您需要根据自己的需要定义每个参数的其他值(函数头中有每个参数的描述)。

    【讨论】:

    • 此解决方案似乎不适用于 ggmap(),但似乎适用于 ggplot()。使用 ggmap 有什么线索吗?
    • 我收到一个错误:Don't know how to automatically pick scale for object of type function. Defaulting to continuous Error in data.frame(x = c(13.15, 13.15, 13.2235616636229, 13.2235616636229, : arguments imply different number of rows: 5, 0 我该怎么办?
    【解决方案3】:

    有一个名为ggsn 的包,它允许您自定义比例尺和指北针。

    ggplot() +
      geom_path(aes(long, lat, group=group), data=worldUk, color="black", fill=NA) +
      coord_equal() +
      ggsn::scalebar(worldUk, dist = 100, st.size=3, height=0.01, dd2km = TRUE, model = 'WGS84')
    

    【讨论】:

      【解决方案4】:

      另一个选项是来自ggspatial 包的annotation_scale。更多关于this 博文的提示。

      library(ggplot2)
      library(maptools)
      data(wrld_simpl)
      
      world_sf <- sf::st_as_sf(wrld_simpl)
      worldUk <- subset(world_sf, NAME == 'United Kingdom')
      

      绘制图层并添加比例尺。

      library(ggspatial)
      
      ggplot() +
        geom_sf(data = worldUk) +
        annotation_scale()
      

      【讨论】:

        猜你喜欢
        • 1970-01-01
        • 1970-01-01
        • 2018-09-29
        • 1970-01-01
        • 2018-10-24
        • 2018-08-14
        • 1970-01-01
        • 2019-06-21
        • 2021-08-15
        相关资源
        最近更新 更多