Etichetta punto dati dinamico Posizionamento in ggmap

Question

Sto lavorando con il pacchetto ggmap in R e sono relativamente nuovo alle visualizzazioni di dati geospaziali. Ho una cornice dati di undici coppie di latitudine e longitudine che vorrei tracciare su una mappa, ognuna con un'etichetta. Ecco i dati manichino:

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) 

Ora uso annotate per creare le etichette dei punti di dati e tracciare questi su una mappa;

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 

Questo produce una trama di punti dati

Come si può vedere, ci sono due punti di dati che si sovrappongono in giro (-122.44,47.63), e le loro etichette anche sovrappongono. Ora posso aggiungere manualmente uno spostamento a ciascun punto dell'etichetta per evitare che le etichette si sovrappongano (vedere this post), ma questa non è una grande tecnica quando ho bisogno di produrre molti di questi grafici per diversi set di coppie di latitudine e longitudine.

Esiste un modo per mantenere automaticamente sovrapposte le etichette dei dati? Mi rendo conto se le sovrapposizioni delle etichette dipendono dalle dimensioni effettive delle figure, quindi sono aperto a fissare le dimensioni della figura in determinate dimensioni, se necessario. Grazie in anticipo per eventuali approfondimenti!

EDIT

Di seguito è modificato il codice utilizzando la risposta data da 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 
    })) 
} 

Generare la trama:

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

Questo è un MOLTO più r trama leggibile, ma con un problema in sospeso. Noterai che l'etichetta "Sito 1E" inizia a sovrapporsi al punto dati associato a "Sito 1A". Le directlabels hanno un modo di trattare le etichette che si sovrappongono a punti dati appartenenti ad un'altra etichetta?

Un'ultima domanda che ho su questo è come è possibile tracciare più etichette duplicate utilizzando questo metodo. Supponiamo che le etichette per data.frame sono tutti uguali:

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

Quando uso lo stesso codice, directlabels rimuove i nomi delle etichette duplicato:

Ma voglio ogni punto di dati di avere un marchio di "test". Eventuali suggerimenti?

Answer 1

Modifica 11 gennaio 2016: usando ggrepel pacchetto con ggplot2 v2.0.0 e v2.6 ggmap

ggrepel funziona bene. Nel codice sottostante, geom_label_repel() mostra alcuni dei parametri disponibili.

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) 

risposta originale, ma aggiornato per ggplot v2.0.0 e v2.6 ggmap

Se c'è solo un piccolo numero di punti che si sovrappongono, quindi utilizzando il metodo "top.bumpup" o "top.bumptwice" dal pacchetto direct label è possibile separarli. Nel codice seguente, utilizzo la funzione geom_dl() per creare e posizionare le etichette.

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: aggiustamento per etichette sottostanti

Un paio di metodi vengono in mente, ma non è del tutto soddisfacente. Ma non credo che troverai una soluzione che si applicherà a tutte le situazioni.

Aggiunta di un colore di sfondo per ogni etichetta
Questo è un po 'di una soluzione, ma directlabels ha una funzione "scatola" (cioè, le etichette sono collocati all'interno di una scatola). Sembra che uno dovrebbe essere in grado di modificare il colore di sfondo e il colore di sfondo nell'elenco in geom_dl, ma non riesco a farlo funzionare. Invece, prendo due funzioni (draw.rects e enlarge.box) da directlabels website; modificali; e combinare le funzioni modificate con il metodo "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")) 

Aggiungi un contorno ad ogni etichetta
Un'altra opzione è quella di utilizzare this method per dare ad ogni etichetta di un contorno, anche se non è immediatamente chiaro come avrebbe funzionato con directlabels. Pertanto, sarebbe necessario un aggiustamento manuale delle coordinate o una ricerca del dataframe per le coordinate che si trovano all'interno di una data soglia, quindi regolare. Tuttavia, qui, utilizzo la funzione pointLabel dal pacchetto maptools per posizionare le etichette. Non garantisco che funzionerà sempre, ma ho ottenuto un risultato ragionevole con i tuoi dati. C'è un elemento casuale incorporato, quindi puoi eseguirlo per un po 'di tempo finché non ottieni un risultato ragionevole. Inoltre, si noti che posiziona le etichette in un grafico di base. Le posizioni dell'etichetta devono quindi essere estratte e caricate in 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)