R ggmap,过度绘图,点相互覆盖

时间:2016-02-29 21:11:23

标签: r ggmap

我有过度绘图的问题。

情况看起来像这样:我有一些带坐标和不同地名的数据,有些地方在同一个地方 - 所以我对几个地名有相同的坐标。如何绘制它们以便它们互相覆盖?我试过不同的形状,最好的选择是传播这些点,或者用几种颜色绘制一个点?但我不知道该怎么做。我将不胜感激任何帮助。

代码示例:

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) 

OUTPUT

更新 根据菲利普的答案,我做了类似的事情:

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)

输出

enter image description here

1 个答案:

答案 0 :(得分:3)

尝试使用geom_jitter代替geom_point。您可以指定widthheight来调整抖动量。

来自文档:

  

width   垂直和水平抖动量。添加了抖动   正负方向,所以总传播是两倍   这里指定的值。如果省略,则默认为40%   数据分辨率:这意味着抖动值将占80%   隐含的箱子。分类数据在整数上对齐,所以a   宽度或高度为0.5将分散数据,因此不可能   看到类别之间的区别。

     

height   垂直量   和水平抖动。抖动以正数和正数相加   负方向,因此总点差是指定值的两倍   这里。如果省略,则默认为数据分辨率的40%:this   表示抖动值将占据隐含箱的80%。   分类数据在整数上对齐,因此宽度或高度为   0.5将传播数据,因此无法看到类别之间的区别。

回复您评论中的后续问题:假设您有一些列(或多列)的数据可能会或可能不会在观察中重复:

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中,所以{ {1}}将返回观察计数,按每次出现x[,.N,keyby=a]分组。此外,由于我已将a的密钥设为x,并使用akeyby本身是x[,.N,keyby=a],其密钥与data.table相同,因此xx[ x[,.N,keyby=a] ] 加入:它加入额外的内部表中的列data.table到外部列中的列。然后N是一个标准的.(a,is.unique=N==1)操作来选择两列的列表,尽管我懒得不使用更多的括号这也可以读作data.table。注意,理解这些命令的最好方法是将它们分解并在REPL中逐步执行,仔细查看输出,直到你了解每个人的所作所为。)

list(a=a,is.unique=(N==1))

让我们添加一列来枚举绘图的观察结果:

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

现在我们可以根据数据是否过度分离来绘制一个图表(注意这个数据没有字面意思,因为在这里我将所有的x值都设置为不同,但我觉得这很容易可视化),正如我建议的那样在评论中:

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

Plot of ten points with default jitter

请注意,只有唯一值(蓝色)才会精确地落在晶格点上。我们可以仅在垂直方向上将抖动调整到抖动点,并且小于默认值:

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

Plot of ten points with no horizontal jitter

顺便提一下,未经请求的风格挑剔:如果你给你的颜色/填充和形状缩放相同的名称,他们将结合起来,你可以拥有一个更好看的传奇。例如:

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)

Plot like first plot but with combined color and shape legend