ggmap中动态数据点标签位置定位

Question

ggmap中动态数据点标签位置定位

7

我正在使用R中的ggmap包，相对于地理空间数据可视化而言，我还是新手。我有一个包含11个纬度和经度对的数据框，我想在地图上绘制它们，每个点上带有标签。以下是虚拟数据：

lat<- c(47.597157,47.656322,47.685928,47.752365,47.689297,47.628128,47.627071,47.586349,47.512684,47.571232,47.562283)

lon<-c(-122.312187,-122.318039,-122.31472,-122.345345,-122.377045,-122.370117,-122.368462,-122.331734,-122.294395,-122.33606,-122.379745)

labels<-c("Site 1A","Site 1B","Site 1C","Site 2A","Site 3A","Site 1D","Site 2C","Site 1E","Site 2B","Site 1G","Site 2G")

df<-data.frame(lat,lon,labels)

现在我使用annotate创建数据点标签，并将其绘制在地图上。

map.data <- get_map(location = c(lon=-122.3485,lat=47.6200), 
                    maptype = 'roadmap', zoom = 11)

pointLabels<-annotate("text",x=uniqueReach$lon,y=c(uniqueReach$lat),size=5,font=3,fontface="bold",family="Helvetica",label=as.vector(uniqueReach$label))

dataPlot <- ggmap(map.data) +
 geom_point(data = uniqueReach,aes(x = df$lon, y = df$lat), alpha = 1,fill="red",pch=21,size = 6) + labs(x = 'Longitude', y = 'Latitude')+pointLabels

这将生成数据点的图形 plot of data points with labels

从图中可以看出，有两个数据点在(-122.44,47.63)附近重叠，并且它们的标签也重叠。现在我可以手动添加每个标签点的偏移量，以防止标签重叠(请参见此帖子)，但当我需要为不同的经度和纬度对产生许多这样的图时，这不是一个很好的技术。

有没有一种方法可以自动避免数据标签重叠？我意识到标签是否重叠取决于实际的图形大小，因此如果需要，我可以固定图形尺寸在某些维度上。谢谢您提前的任何见解！

编辑

以下是使用Sandy Mupratt给出的答案修改后的代码

# Defining function to draw text boxes
draw.rects.modified <- function(d,...){
  if(is.null(d$box.color))d$box.color <- NA
  if(is.null(d$fill))d$fill <- "grey95"
  for(i in 1:nrow(d)){
    with(d[i,],{
      grid.rect(gp = gpar(col = box.color, fill = fill,alpha=0.7),
                vp = viewport(x, y, w, h, "cm", c(hjust, vjust=0.25), angle=rot))
    })
  }
  d
}


# Defining function to determine text box borders
enlarge.box.modified <- function(d,...){
  if(!"h"%in%names(d))stop("need to have already calculated height and width.")
  calc.borders(within(d,{
    w <- 0.9*w
    h <- 1.1*h
  }))
}

生成绘图：

dataplot<-ggmap(map.data) + 
                 geom_point(data = df,aes(x = df$lon, y = df$lat), 
                            alpha = 1, fill = "red", pch = 21, size = 6) + 
                  labs(x = 'Longitude', y = 'Latitude') +
                  geom_dl(data = df, 
                      aes(label = labels), 
                      list(dl.trans(y = y + 0.3), "boxes", cex = .8, fontface = "bold"))

在文本框内的标签和ggmap图

这是一个更易读的图，但仍存在一个显着问题。注意到标签“Site 1E”开始与关联到“Site 1A”的数据点重叠。Directlabels有办法解决标签重叠到其他标签的数据点的问题吗？

最后，我有一个问题：如何使用此方法绘制多个重复标签。假设data.frame的标签都是相同的：

df$labels<-rep("test",dim(df)[1])

当我使用相同的代码时，directlabels会删除重复的标签名称： enter image description here

但是我希望每个数据点都有一个"label"为"test"。有什么建议吗？

- Archimeow

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Sandy Muspratt · Accepted Answer

2016年1月11日更新：使用ggrepel包与ggplot2 v2.0.0和ggmap v2.6

ggrepel表现良好。在下面的代码中，geom_label_repel()显示了一些可用参数。

lat <- c(47.597157,47.656322,47.685928,47.752365,47.689297,47.628128,47.627071,
         47.586349,47.512684,47.571232,47.562283)
lon <- c(-122.312187,-122.318039,-122.31472,-122.345345,-122.377045,-122.370117,
        -122.368462,-122.331734,-122.294395,-122.33606,-122.379745)
labels <- c("Site 1A","Site 1B","Site 1C","Site 2A","Site 3A","Site 1D",
        "Site 2C","Site 1E","Site 2B","Site 1G","Site 2G")

df <- data.frame(lat,lon,labels)

library(ggmap)
library(ggrepel)
library(grid)

map.data <- get_map(location = c(lon = -122.3485, lat = 47.6200), 
                    maptype = 'roadmap', zoom = 11)

ggmap(map.data) + 
   geom_point(data = df, aes(x = lon, y = lat), 
      alpha = 1, fill = "red", pch = 21, size = 5) + 
   labs(x = 'Longitude', y = 'Latitude') +
   geom_label_repel(data = df, aes(x = lon, y = lat, label = labels), 
                 fill = "white", box.padding = unit(.4, "lines"),
                 label.padding = unit(.15, "lines"),
                 segment.color = "red", segment.size = 1)

原始答案，但已更新为 ggplot v2.0.0 和 ggmap v2.6

如果只有少量重叠点，则可以使用直接标签包中的 "top.bumpup" 或 "top.bumptwice" 方法来分隔它们。在下面的代码中，我使用 geom_dl() 函数创建和定位标签。

 lat <- c(47.597157,47.656322,47.685928,47.752365,47.689297,47.628128,47.627071,
         47.586349,47.512684,47.571232,47.562283)
 lon <- c(-122.312187,-122.318039,-122.31472,-122.345345,-122.377045,-122.370117,
        -122.368462,-122.331734,-122.294395,-122.33606,-122.379745)
 labels <- c("Site 1A","Site 1B","Site 1C","Site 2A","Site 3A","Site 1D",
        "Site 2C","Site 1E","Site 2B","Site 1G","Site 2G")
 df <- data.frame(lat,lon,labels)

library(ggmap)
library(directlabels)

map.data <- get_map(location = c(lon = -122.3485, lat = 47.6200), 
                    maptype = 'roadmap', zoom = 11)
ggmap(map.data) + 
   geom_point(data = df, aes(x = lon, y = lat), 
      alpha = 1, fill = "red", pch = 21, size = 6) + 
   labs(x = 'Longitude', y = 'Latitude') +
   geom_dl(data = df, aes(label = labels), method = list(dl.trans(y = y + 0.2), 
      "top.bumptwice", cex = .8, fontface = "bold", family = "Helvetica"))

输入图像描述

编辑：调整底层标签

有几种方法可以想到，但都不是完全令人满意的。但我认为你不会找到适用于所有情况的解决方案。

为每个标签添加背景颜色
这是一个解决方法，但是directlabels有一个“box”函数（即，标签被放置在一个框中）。看起来应该能够在geom_dl列表中修改背景填充和边框颜色，但我无法让它工作。相反，我从directlabels网站取出两个函数（draw.rects和enlarge.box）；修改它们；并将修改后的函数与“top.bumptwice”方法相结合。

draw.rects.modified <- function(d,...){
  if(is.null(d$box.color))d$box.color <- NA
  if(is.null(d$fill))d$fill <- "grey95"
  for(i in 1:nrow(d)){
    with(d[i,],{
      grid.rect(gp = gpar(col = box.color, fill = fill),
                vp = viewport(x, y, w, h, "cm", c(hjust, vjust=0.25), angle=rot))
    })
  }
  d
}

enlarge.box.modified <- function(d,...){
  if(!"h"%in%names(d))stop("need to have already calculated height and width.")
  calc.borders(within(d,{
    w <- 0.9*w
    h <- 1.1*h
  }))
}

boxes <-
  list("top.bumptwice", "calc.boxes",  "enlarge.box.modified", "draw.rects.modified")

ggmap(map.data) + 
   geom_point(data = df,aes(x = lon, y = lat), 
      alpha = 1, fill = "red", pch = 21, size = 6) + 
   labs(x = 'Longitude', y = 'Latitude') +
   geom_dl(data = df, aes(label = labels), method = list(dl.trans(y = y + 0.3), 
      "boxes", cex = .8, fontface = "bold"))

输入图片描述

为每个标签添加轮廓线
另一种选择是使用这种方法为每个标签添加轮廓线，尽管它不会立即清楚如何与directlabels配合使用。因此，需要手动调整坐标或搜索数据帧中距离给定阈值内的坐标，然后进行调整。但是，在这里，我使用maptools包中的pointLabel函数来定位标签。不能保证它每次都能正常工作，但是我用您的数据得到了一个合理的结果。其中有一个随机因素，所以您可以多次运行它，直到获得合理的结果。还要注意，它在基本图中放置标签。然后必须提取并加载ggplot / ggmap中的标签位置。

lat<- c(47.597157,47.656322,47.685928,47.752365,47.689297,47.628128,47.627071,47.586349,47.512684,47.571232,47.562283)
lon<-c(-122.312187,-122.318039,-122.31472,-122.345345,-122.377045,-122.370117,-122.368462,-122.331734,-122.294395,-122.33606,-122.379745)
labels<-c("Site 1A","Site 1B","Site 1C","Site 2A","Site 3A","Site 1D","Site 2C","Site 1E","Site 2B","Site 1G","Site 2G")
df<-data.frame(lat,lon,labels)

library(ggmap)
library(maptools)  # pointLabel function

# Get map
map.data <- get_map(location = c(lon=-122.3485,lat=47.6200), 
                    maptype = 'roadmap', zoom = 11)

bb = t(attr(map.data, "bb"))   # the map's bounding box

# Base plot to plot points and using pointLabels() to position labels
plot(df$lon, df$lat, pch = 20, cex = 5, col = "red", xlim = bb[c(2,4)], ylim = bb[c(1,3)])
new = pointLabel(df$lon, df$lat, df$labels, pos = 4, offset = 0.5, cex = 1)
new = as.data.frame(new)
new$labels = df$labels

## Draw the map
map = ggmap(map.data) + 
       geom_point(data = df, aes(x = lon, y = lat), 
          alpha = 1, fill = "red", pch = 21, size = 5) + 
       labs(x = 'Longitude', y = 'Latitude') 

## Draw the label outlines 
theta <- seq(pi/16, 2*pi, length.out=32)
xo <- diff(bb[c(2,4)])/400
yo <- diff(bb[c(1,3)])/400

for(i in theta) {
    map <- map + geom_text(data = new,  
       aes_(x = new$x + .01 + cos(i) * xo, y = new$y + sin(i) * yo, label = labels), 
                  size = 3, colour = 'black', vjust = .5, hjust = .8)
}

# Draw the labels
map + 
   geom_text(data = new, aes(x = x + .01, y = y, label=labels), 
     size = 3, colour = 'white', vjust = .5, hjust = .8)

enter image description here