Dynamisches Datenpunkt-Label Positionierung in ggmap

Question

Ich arbeite mit dem ggmap-Paket in R und bin relativ neu in der Visualisierung von Geodaten. Ich habe einen Datenrahmen von elf Breiten- und Längenpaaren, die ich auf einer Karte mit jeweils einem Label plotten möchte. Hier sind die Dummy-Daten:

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) 

Jetzt benutze ich annotate die Datenpunktbeschriftungen zu erstellen und diese auf einer Karte plotten;

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 

Dies erzeugt eine Darstellung der Datenpunkte

Wie Sie sehen können, gibt es zwei Datenpunkte, die sich um überlappen (-122.44,47.63) und deren Etiketten überlappen auch. Jetzt kann ich jedem Etikettpunkt manuell eine Verschiebung hinzufügen, damit sich die Beschriftungen nicht überschneiden (siehe this post), aber das ist keine großartige Technik, wenn ich viele dieser Diagramme für verschiedene Sätze von Längen- und Breitengraden erzeugen muss.

Gibt es eine Möglichkeit, Datenbezeichnungen automatisch zu überlappen? Ich merke, ob sich die Etiketten überlappen, hängt von der tatsächlichen Größe der Figur ab, also bin ich offen dafür, die Größe der Figur bei bestimmten Dimensionen zu fixieren. Vielen Dank im Voraus für alle Einsichten!

EDIT

Der folgende Code geändert wird, um die von Sandy Mupratt gegebene Antwort mit

# 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 
    })) 
} 

die Handlung generieren:

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

Dies ist ein viel mehr r eadable Handlung, aber mit einem ausstehenden Problem. Sie werden feststellen, dass die Bezeichnung "Site 1E" beginnt, den Datenpunkt zu überlappen, der mit "Site 1A" verknüpft ist. Haben Directlabels eine Möglichkeit, mit Labels zu arbeiten, die Datenpunkte eines anderen Labels überlappen?

Eine letzte Frage, die ich diesbezüglich habe, ist, wie kann ich mehrere doppelte Etiketten mit dieser Methode plotten. Nehmen wir an, die Etiketten für data.frame sind alle gleich:

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

Wenn ich den gleichen Code verwenden, directlabels entfernt die doppelte Label-Namen:

Aber ich möchte jeden Datenpunkt haben, ein Label von "Prüfung". Irgendwelche Vorschläge?

Answer 1

bearbeiten 11. Januar 2016: mit ggrepel Paket mit ggplot2 v2.0.0 und ggmap v2.6

ggrepel funktioniert gut. Im folgenden Code zeigt geom_label_repel() einige der verfügbaren Parameter.

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-Antwort, aber für ggplot v2.0.0 aktualisiert und ggmap v2.6

Wenn es nur eine kleine Anzahl von Überlappungspunkten, dann Verwenden Sie die Methode "top.bumpup" oder "top.bumptwice" aus dem Paket mit den direkten Etiketten, um sie zu trennen. Im folgenden Code verwende ich die geom_dl() Funktion, um die Etiketten zu erstellen und zu positionieren.

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: Einstellung für zugrunde liegende Etikett

Ein paar Methoden in dem Sinne, aber keiner ist ganz zufriedenstellend. Aber ich denke nicht, dass Sie eine Lösung finden werden, die für alle Situationen gilt.

eine Hintergrundfarbe jedes Etikett Hinzufügen
Dies ist ein Bit einer Behelfslösung, aber directlabels hat eine „Box“ Funktion (das heißt, die Etiketten in einem Feld angeordnet sind). Es sieht so aus, als ob man in der Lage sein sollte, Hintergrundfüllung und Rahmenfarbe in der Liste in geom_dl zu ändern, aber ich kann es nicht zum Laufen bringen. Stattdessen nehme ich zwei Funktionen (draw.rects und enlarge.box) von der directlabels website; modifiziere sie; und kombiniere die modifizierten Funktionen mit der "top.bumptwice" -Methode.

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

einen Umriss jedes Etikett
Eine weitere Option hinzufügen zu verwenden this method ist jedes Etikett einen Überblick zu geben, auch wenn es nicht sofort klar ist, wie es mit directlabels funktionieren würde. Daher würde es eine manuelle Anpassung der Koordinaten erfordern, oder eine Suche des Datenrahmens nach Koordinaten, die innerhalb einer gegebenen Schwelle liegen, dann anpassen. Allerdings verwende ich hier die pointLabel Funktion von maptools Paket, um die Etiketten zu positionieren. Keine Garantie, dass es jedes Mal funktioniert, aber ich habe mit Ihren Daten ein vernünftiges Ergebnis erzielt. Es ist ein zufälliges Element eingebaut, so dass Sie es ein paar Mal ausführen können, bis Sie ein vernünftiges Ergebnis erhalten. Beachten Sie auch, dass Beschriftungen in einem Basisdiagramm positioniert werden. Die Label-Positionen müssen dann extrahiert und in die ggplot/ggmap geladen werden.

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)