R ggmap，覆蓋繪圖，點覆蓋對方

Question

我有覆蓋繪圖的問題。

情況看起來像這樣：我有一些座標和不同地名的數據，有些地方是在同一個地方 - 所以我有幾個地名相同的座標。如何繪製它們，讓它們不會互相遮掩？我嘗試過不同的形狀，最好的選擇是散佈這些點，或者用少量的顏色繪製一個點。但我不知道如何去做。我會感謝任何幫助。

代碼示例：

require(rgdal) 
require(ggmap) 
require(maptools) 
require (plyr) 

swd <- structure(list(nazwa = structure(c(8L, 8L, 9L, 7L, 7L, 7L, 3L, 
            5L, 6L, 4L, 2L, 2L, 1L), .Label = c("ODDZIAŁ CHIRURGII ONKOLOGICZNEJ", 
                     "ODDZIAŁ GINEKOLOGII ONKOLOGICZNEJ", "ODDZIAŁ ONKOLOGICZNY", 
                     "ODDZIAŁ ONKOLOGII I HEMATOLOGII DZIECIĘCEJ", "ODDZIAŁ ONKOLOGII KLINICZNEJ CHEMIOTERAPII", 
                     "ODDZIAŁ RADIOTERAPII", "PORADNIA CHIRURGII ONKOLOGICZNEJ", "PORADNIA ONKOLOGICZNA", 
                     "PORADNIA RADIOTERAPII"), class = "factor"), miasto = structure(c(8L, 
                                     8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L), .Label = c("DZIAŁDOWO", 
                                                    "ELBLĄG", "EŁK", "GIŻYCKO", "MRĄGOWO", "NOWE MIASTO LUBAWSKIE", 
                                                    "OLECKO", "OLSZTYN", "OSTRÓDA", "PISZ", "SZCZYTNO"), class = "factor"), 
       dom = structure(c(17L, 5L, 17L, 17L, 8L, 18L, 5L, 17L, 17L, 
           20L, 17L, 19L, 17L), .Label = c("BARANKI 24", "GNIEŹNIEŃSKA 2", 
                   "GOŁDAPSKA 1", "HENRYKA SIENKIEWICZA 4", "JAGIELLOŃSKA 78", 
                   "JANA III SOBIESKIEGO 3 C/44", "KONOPNICKIEJ 1", "KOPERNIKA 30", 
                   "KOŚCIUSZKI 30", "KRÓLEWIECKA 146", "KRÓLEWIECKA 146 146", 
                   "LEŚNA 1", "MICKIEWICZA 10", "MICKIEWICZA 14", "OSEDLE MAZURSKIE 33 A", 
                   "WARSZAWSKA 41", "WOJSKA POLSKIEGO 37", "ŻOŁNIERSKA 16B", 
                   "ŻOŁNIERSKA 18", "ŻOŁNIERSKA 18 A"), class = "factor"), Lat = c(53.794077, 
                                   53.80182, 53.794077, 53.794077, 53.7827025, 53.7688275, 53.80182, 
                                   53.794077, 53.794077, 53.7696245, 53.794077, 53.7698809, 
                                   53.794077), Long = c(20.483249, 20.508952, 20.483249, 20.483249, 
                                         20.4918876, 20.4903438, 20.508952, 20.483249, 20.483249, 
                                         20.4927874, 20.483249, 20.492049, 20.483249)), .Names = c("nazwa", 
                                                       "miasto", "dom", "Lat", "Long"), row.names = c(1L, 2L, 12L, 13L, 
                                                                   14L, 15L, 23L, 25L, 27L, 29L, 30L, 31L, 32L), class = "data.frame") 
polska <- get_googlemap(
    center =c('Olsztyn, Polska'), 
    zoom=12, 
    maptype="roadmap" , 
    scale = 2 
    ,color = "bw" 
) 
kontury<- ggmap(polska) 




punkty <- kontury+ geom_point(aes(x=Long, y=Lat, color=nazwa, shape=nazwa) 
           ,data=subset(swd,( nazwa=='ODDZIAŁ GINEKOLOGII ONKOLOGICZNEJ'| 
                nazwa=='PORADNIA CHIRURGII ONKOLOGICZNEJ'| 
                nazwa=='ODDZIAŁ ONKOLOGII KLINICZNEJ CHEMIOTERAPII'| 
                nazwa=='PORADNIA ONKOLOGICZNA'| 
                nazwa=='ODDZIAŁ RADIOTERAPII'& 
                miasto=="OLSZTYN")) 
           ,size=7 

)+ 

    guides(fill = guide_legend(ncol = 1)) + 
    theme(legend.position="right") + 
    scale_shape_manual(values = c(15,16,17,18,19,20), name="Symbol") 

print(punkty) 

UPDATE 基礎上的答案從菲利普我做了這樣的事情：

require(rgdal) 
require(ggmap) 
require(maptools) 
require (plyr) 

swd <- structure(list(nazwa = structure(c(8L, 8L, 9L, 7L, 7L, 7L, 3L, 
              5L, 6L, 4L, 2L, 2L, 1L), .Label = c("ODDZIAŁ CHIRURGII ONKOLOGICZNEJ", 
                       "ODDZIAŁ GINEKOLOGII ONKOLOGICZNEJ", "ODDZIAŁ ONKOLOGICZNY", 
                       "ODDZIAŁ ONKOLOGII I HEMATOLOGII DZIECIĘCEJ", "ODDZIAŁ ONKOLOGII KLINICZNEJ CHEMIOTERAPII", 
                       "ODDZIAŁ RADIOTERAPII", "PORADNIA CHIRURGII ONKOLOGICZNEJ", "PORADNIA ONKOLOGICZNA", 
                       "PORADNIA RADIOTERAPII"), class = "factor"), miasto = structure(c(8L, 
                                       8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L), .Label = c("DZIAŁDOWO", 
                                                      "ELBLĄG", "EŁK", "GIŻYCKO", "MRĄGOWO", "NOWE MIASTO LUBAWSKIE", 
                                                      "OLECKO", "OLSZTYN", "OSTRÓDA", "PISZ", "SZCZYTNO"), class = "factor"), 
         dom = structure(c(17L, 5L, 17L, 17L, 8L, 18L, 5L, 17L, 17L, 
             20L, 17L, 19L, 17L), .Label = c("BARANKI 24", "GNIEŹNIEŃSKA 2", 
                     "GOŁDAPSKA 1", "HENRYKA SIENKIEWICZA 4", "JAGIELLOŃSKA 78", 
                     "JANA III SOBIESKIEGO 3 C/44", "KONOPNICKIEJ 1", "KOPERNIKA 30", 
                     "KOŚCIUSZKI 30", "KRÓLEWIECKA 146", "KRÓLEWIECKA 146 146", 
                     "LEŚNA 1", "MICKIEWICZA 10", "MICKIEWICZA 14", "OSEDLE MAZURSKIE 33 A", 
                     "WARSZAWSKA 41", "WOJSKA POLSKIEGO 37", "ŻOŁNIERSKA 16B", 
                     "ŻOŁNIERSKA 18", "ŻOŁNIERSKA 18 A"), class = "factor"), Lat = c(53.794077, 
                                     53.80182, 53.794077, 53.794077, 53.7827025, 53.7688275, 53.80182, 
                                     53.794077, 53.794077, 53.7696245, 53.794077, 53.7698809, 
                                     53.794077), Long = c(20.483249, 20.508952, 20.483249, 20.483249, 
                                          20.4918876, 20.4903438, 20.508952, 20.483249, 20.483249, 
                                          20.4927874, 20.483249, 20.492049, 20.483249)), .Names = c("nazwa", 
                                                         "miasto", "dom", "Lat", "Long"), row.names = c(1L, 2L, 12L, 13L, 
                                                                     14L, 15L, 23L, 25L, 27L, 29L, 30L, 31L, 32L), class = "data.frame") 

swd <- data.table(swd)   # idk rly why but it didnt want to work w/o this command 
setkey(swd,dom) 
swd <- swd[swd[,.N,keyby=dom],.(dom,is.unique=N==1,nazwa,miasto,Lat,Long)] 

olsztynOSM <- get_openstreetmap(bbox = c (left=20.4359, bottom = 53.7319, right= 20.5623, top= 53.81), scale = 40913, color = c('color')) 

moja.paleta <- brewer.pal(9, "Set1") 
swd$kolor <- moja.paleta[swd$nazwa] 

konturyOSM<- ggmap(olsztynOSM) 


punkty <- konturyOSM + geom_jitter(aes(x=Long,y=Lat,fill=nazwa), data = swd[!(is.unique)], width=0.006,height=0.006, size=7,pch=21) + 
    geom_point(aes(x=Long,y=Lat,fill=nazwa), data = swd[(is.unique)], size=7, pch=25)+ 

    scale_fill_manual(values=setNames(moja.paleta,levels(swd$nazwa)),name='Legenda') + 
    guides(fill = guide_legend(ncol = 1)) + 
    theme(legend.position="right") 

plot(punkty) 

輸出

Answer 1

嘗試geom_jitter而不是geom_point。您可以指定width和height來調整抖動量。

從文檔：

width Amount of vertical and horizontal jitter. The jitter is added in both positive and negative directions, so the total spread is twice the value specified here. If omitted, defaults to 40% of the resolution of the data: this means the jitter values will occupy 80% of the implied bins. Categorical data is aligned on the integers, so a width or height of 0.5 will spread the data so it's not possible to see the distinction between the categories.

height Amount of vertical and horizontal jitter. The jitter is added in both positive and negative directions, so the total spread is twice the value specified here. If omitted, defaults to 40% of the resolution of the data: this means the jitter values will occupy 80% of the implied bins. Categorical data is aligned on the integers, so a width or height of 0.5 will spread the data so it's not possible to see the distinction between the categories.

爲響應您的評論的後續問題：假設你有一個列中的某些數據（或列），可能會或可能不會跨越觀察複製：

library(data.table) 
set.seed(123) 
x <- data.table(a=sample(1:5,10,replace=T)) 
setkey(x,a) 

> x 
    a 
1: 1 
2: 2 
3: 3 
4: 3 
5: 3 
6: 3 
7: 4 
8: 5 
9: 5 
10: 5 

現在，我們可以添加一列指示值是否是唯一的或者不：（編輯您的其他評論回答的問題：在data.table .N = count，所以x[,.N,keyby=a]將返回觀察值的計數，按每次出現a分組。另外，因爲我已經設置的x關鍵是a，並使用keyby，x[,.N,keyby=a]本身就是一個data.table使用相同的密鑰x，所以x[ x[,.N,keyby=a] ]是data.table加入：它的內表加入額外的列N到在外面的列。然後.(a,is.unique=N==1)是一個標準的data.table操作來選擇兩列的列表，雖然我懶惰沒有使用更多的括號。這也可以被解讀爲list(a=a,is.unique=(N==1))。請注意，理解這些命令的最好方法是將它們分解並在REPL中逐步執行它們，仔細查看輸出，直到您瞭解每個命令的作用。）

pts <- x[x[,.N,keyby=a],.(a,is.unique=N==1)] 
> pts 
    a is.unique 
1: 1  TRUE 
2: 2  TRUE 
3: 3  FALSE 
4: 3  FALSE 
5: 3  FALSE 
6: 3  FALSE 
7: 4  TRUE 
8: 5  FALSE 
9: 5  FALSE 
10: 5  FALSE 

讓我們添加一列剛剛列舉的觀測數據繪製：

pts[,b:=.I] 
> pts 
    a is.unique b 
1: 1  TRUE 1 
2: 2  TRUE 2 
3: 3  FALSE 3 
4: 3  FALSE 4 
5: 3  FALSE 5 
6: 3  FALSE 6 
7: 4  TRUE 7 
8: 5  FALSE 8 
9: 5  FALSE 9 
10: 5  FALSE 10 

現在我們可以做一個陰謀數據是否會被overplotted分離（注意不是字面上這個數據，因爲在這裏我把所有的x值不同，但我認爲這是很容易反正可視化），我在評論所說：

ggplot(pts,aes(x=b,y=a)) + 
    geom_point(data=pts[(is.unique)],color="blue") + 
    geom_jitter(data=pts[!(is.unique)],color="red") 

請注意只有唯一值（藍色）精確地落在格點上。我們可以調整抖動說抖動點只在垂直方向，並小於默認：

ggplot(pts,aes(x=b,y=a)) + 
    geom_point(data=pts[(is.unique)],color="blue") + 
    geom_jitter(data=pts[!(is.unique)],color="red",width=0,height=.2) 

順便說一句，不請自來的文體挑剔：如果你給你的顏色/填充和形狀縮放相同名字，他們會結合起來，你可以有一個更好看的傳說。例如： -

ggplot(pts,aes(x=b,y=a,color=is.unique,shape=is.unique)) + 
    geom_point(data=pts[(is.unique)]) + 
    geom_jitter(data=pts[(!is.unique)]) + 
    scale_color_manual(values=c("red","blue"),name="Unique a?") + 
    scale_shape_manual(values=c(15,16),name="Unique a?")