Dynamiczna etykieta punktu danych Pozycjonowanie w ggmap

Question

Pracuję z pakietem ggmap w R i jestem stosunkowo nowy w wizualizacjach danych geoprzestrzennych. Mam ramkę danych z jedenastoma parami szerokości i długości geograficznej, które chciałbym wydrukować na mapie, każda z etykietą. Oto dane manekina:

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) 

Teraz używam annotate tworzyć etykiety punkt danych i wykreślić je na mapie;

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 

To daje wykres punktów danych

Jak widać, istnieją dwa punkty danych, które pokrywają około (-122.44,47.63), a ich etykiety również pokrywać. Teraz mogę ręcznie dodać przesunięcie do każdego punktu etykiety, aby etykiety nie zachodziły na siebie (patrz this post), ale nie jest to świetna technika, gdy trzeba wyprodukować wiele z tych wykresów dla różnych zestawów długości i szerokości geograficznej.

Czy jest sposób, w jaki mogę automatycznie zapobiegać nakładaniu się etykiet danych? Zdaję sobie sprawę, czy nakładanie się etykiet zależy od rzeczywistej wielkości figury, więc jestem otwarty na ustalenie rozmiaru figury w pewnych wymiarach, jeśli zajdzie taka potrzeba. Z góry dziękuję za wszelkie spostrzeżenia!

EDIT

Kolumnę zmodyfikowany kod za odpowiedź udzieloną przez 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 
    })) 
} 

generowania wykresu czynności:

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")) 

Jest to znacznie więcej r działka, ale z jedną nierozstrzygniętą kwestią. Zauważysz, że etykieta "Site 1E" zaczyna pokrywać się z punktem danych powiązanym z "Site 1A". Czy directlabele mają sposób radzenia sobie z etykietami nakładającymi się na punkty danych należących do innej etykiety?

Ostatnim pytaniem, które mam na ten temat, jest to, jak wykreślić kilka duplikatów etykiet za pomocą tej metody. Załóżmy, etykiety dla data.frame są takie same:

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

Kiedy użyć tego samego kodu, directlabels usuwa zduplikowane nazwy etykiet:

Ale chcę Każdy punkt danych, aby mieć etykietę "test". Jakieś sugestie?

Answer 1

Edycja 11 stycznia 2016: używanie ggrepel pakiet z ggplot2 v2.0.0 i ggmap v2.6

ggrepel działa dobrze. W poniższym kodzie geom_label_repel() pokazuje niektóre z dostępnych parametrów.

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) 

Original odpowiedź ale aktualizowana ggplot v2.0.0 i ggmap v2.6

Jeśli istnieje tylko niewielka liczba nakładających się punkty, a następnie użycie metody "top.bumpup" lub "top.bumptwice" z pakietu bezpośrednich etykiet może je rozdzielić. W poniższym kodzie używam funkcji geom_dl() do tworzenia i pozycjonowania etykiet.

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")) 

Edit: Regulacja na etykietach bazowych

Kilka metod wiosny do umysłu, ale nie jest w pełni zadowalające. Ale nie sądzę, że znajdziesz rozwiązanie, które będzie miało zastosowanie do wszystkich sytuacji.

Dodanie kolor tła dla każdej etykiety
Jest nieco obejście, ale directlabels dysponuje funkcją „box” (to znaczy, że znaczniki są umieszczone w pudełku). Wygląda na to, że należy zmodyfikować wypełnienie tła i kolor obramowania na liście w geom_dl, ale nie mogę go uruchomić. Zamiast tego biorę dwie funkcje (draw.rects i enlarge.box) od directlabels website; zmodyfikuj je; i połącz zmodyfikowane funkcje z metodą "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")) 

Dodaj zarys do każdej etykiecie
Inną opcją jest użycie this method dać każdej etykiecie konspekt, choć nie jest od razu jasne, w jaki sposób pracować z directlabels. W związku z tym konieczne byłoby ręczne dopasowanie współrzędnych lub przeszukanie ramki danych pod kątem współrzędnych, które mieszczą się w określonym progu, a następnie dostosowywane. Jednak tutaj używam funkcji pointLabel z pakietu maptools, aby umieścić etykiety. Nie ma gwarancji, że zadziała za każdym razem, ale uzyskałem rozsądny wynik z twoimi danymi. Wbudowany jest element losowy, więc możesz go uruchomić kilka razy, aż uzyskasz rozsądny wynik. Zwróć też uwagę, że umieszcza etykiety na wykresie bazowym. Lokalizacje etykiet muszą następnie zostać wyodrębnione i załadowane do 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)