動態數據點標籤在ggmap中定位

Question

我在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 

這將產生數據點

的情節一樣，你可以看到，有四處重疊（-122.44,47.63）兩個數據點，其標籤也有重疊。現在，我可以手動爲每個標籤點添加一個移位，以防止標籤重疊（請參閱this post），但當我需要爲不同的經緯度對生成很多這些圖時，這不是一個好方法。

有沒有一種方法可以自動保持數據標籤不重疊？我意識到標籤是否重疊取決於實際的身材尺寸，所以我打算在需要時將身材尺寸固定在某個尺寸。提前感謝您的任何見解！

編輯

使用桑迪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")) 

這是一個非常更多r可靠的情節，但有一個突出的問題。您會注意到標籤「Site 1E」開始重疊與「Site 1A」關聯的數據點。直接標籤是否有處理標籤重疊屬於另一個標籤的數據點的方法？

我對此有一個最後的問題是如何使用這種方法繪製幾個重複的標籤。假設標籤data.frame都是一樣的：

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

當我使用相同的代碼，directlabels刪除重複的標籤名稱：

但我想每個數據點有一個標籤「測試」。有什麼建議麼？

Answer 1

編輯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) 

原來的答覆，但更新的V2.0.0 ggplot和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具有「箱」功能（即，標籤被放置在一個盒子裏）。它看起來應該能夠修改geom_dl列表中的背景填充和邊框顏色，但我無法使其工作。相反，我從directlabels website獲取兩個函數（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")) 

添加大綱每個標籤
另一種選擇是使用this method給每個標籤的輪廓，雖然尚不清楚它如何與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)