R ggmap，过度绘图，点相互覆盖答案

【问题标题】：R ggmap, over-plotting ,points cover each otherR ggmap，过度绘图，点相互覆盖
【发布时间】：2016-03-02 15:30:54
【问题描述】：

我有过度绘图的问题。

情况如下所示：我有一些带有坐标和不同地名的数据，一些地方在同一个版本中 - 所以我有几个地名的相同坐标。如何绘制它以使它们不会相互覆盖？我尝试了不同的形状，最好的选择是散布这些点，或者用很少的颜色绘制一个点？但我不知道该怎么做。我将不胜感激任何帮助。

代码示例：

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)

更新根据 Philip 的回答，我做了这样的事情：

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)

输出

【问题讨论】：

标签： r ggmap

【解决方案1】：

尝试geom_jitter 而不是geom_point。您可以指定width 和height 来调整抖动量。

来自文档：

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

height 垂直量和水平抖动。抖动添加在正和负方向，因此总价差是指定值的两倍这里。如果省略，则默认为数据分辨率的 40%：this 意味着抖动值将占据 80% 的隐含 bin。分类数据在整数上对齐，因此宽度或高度为 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，所以 x[,.N,keyby=a]将返回观察计数，按a 的每次出现分组。此外，由于我已经将x 的键设置为a，并使用keyby，x[,.N,keyby=a] 本身就是一个data.table，具有相同的键为x，所以x[ x[,.N,keyby=a] ] 是data.table join：它将内表中的额外列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

现在我们可以按照我的建议，根据数据是否会被过度绘制来进行绘图（注意不是字面上的数据，因为在这里我使所有 x 值都不同，但我认为无论如何这很容易可视化）在评论中：

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

请注意只有唯一值（蓝色）如何精确地落在格点上。我们可以调整 jitter say to jitter points only 垂直，并且小于默认值：

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

【讨论】：

然后我会调整所有点，不仅是少数地名具有相同坐标的点，而且我在坐标上还有更多具有单一名称的点。在这个数据样本中，我只提出了问题，原始数据要大得多。还是我错了？我会在第二次尝试并写下我所看到的。
如果这是一个大问题，您可以拆分数据（将数据拆分为两个 data.frames，或者添加一列用作指标并使用 data 参数到 geom_point），然后做两层：一层用于带有geom_point 的唯一数据，一层用于带有geom_jitter（或等效地带有width/height=0）的可能被重叠的数据。我添加了一个虚拟 MWE，您应该能够修改以获得您的结果。
非常感谢您的努力，您的示例非常有用。我会试一试，我会尝试将您的想法添加到我的脚本中。谢谢！ :)
你知道为什么我不能在地图上使用 ggplot 吗？当我尝试时出现错误：Error in p + o : non-numeric argument to binary operator In addition: Warning message: Incompatible methods ("+.gg", "Ops.data.frame") for "+" 当我这样做时它可以工作：kontury<- ggmap(polska) punkty <- kontury + geom_jitter(aes(x=Long,y=Lat,color=nazwa), data = swd, width=0.02,height=.05, size=7) 但是当我使用 2 个不同的函数时，我遇到了图例问题：geom point 和 jitter 都带有 aes 内部。
此外，您还可以通过将尽可能多的通用美学放在最高级别的命令中来帮助避免错误并简化代码。因此，例如，您可能想做类似ggmap(polska,aes(x=Long,y=Lat,color=nazwa,shape=nazwa)) + geom_point(data=....) + geom_jitter(data=....) 之类的事情，而不是在每个geom 中重复aess。