R ggmap，过度绘制，点相互覆盖
R ggmap, over-plotting ,points cover each other
我有过度绘制的问题。
情况是这样的：我有一些坐标和不同地名的数据，有些地方在同一个构建中 - 所以我有几个地名的相同坐标。如何绘制它以使它们不会相互覆盖？我尝试了不同的形状，最好的选择是散布这些点，或者用很少的颜色绘制一个点？但我不知道该怎么做。我将不胜感激任何帮助。
代码示例：
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)
输出
尝试 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 = 计数，所以 x[,.N,keyby=a] 将 return 观察计数，按 a 的每次出现分组。此外，因为我已经将 x 的键设置为 a，并使用keyby，x[,.N,keyby=a]本身就是一个data.table，与x具有相同的键，所以x[ x[,.N,keyby=a] ]是一个data.tablejoin：它将内部table中的额外列N连接到外部列中。然后.(a,is.unique=N==1)是一个标准data.table对 select 两列列表的操作，尽管我很懒惰，没有使用不必要的括号。这也可以读作 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")
注意只有唯一值（蓝色）如何精确地落在格点上。我们可以将抖动调整为仅垂直抖动点，并且小于默认值：
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)
顺便说一下，不请自来的文体吹毛求疵：如果你给你的 color/fill 和形状标尺起相同的名字，它们就会结合起来，你可以有一个更好看的图例。例如：
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?")
我有过度绘制的问题。
情况是这样的：我有一些坐标和不同地名的数据，有些地方在同一个构建中 - 所以我有几个地名的相同坐标。如何绘制它以使它们不会相互覆盖？我尝试了不同的形状，最好的选择是散布这些点，或者用很少的颜色绘制一个点？但我不知道该怎么做。我将不胜感激任何帮助。
代码示例：
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)
输出
尝试 geom_jitter 而不是 geom_point。您可以指定 width 和 height 来调整抖动量。
来自文档：
widthAmount 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.
heightAmount 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 = 计数，所以 x[,.N,keyby=a] 将 return 观察计数，按 a 的每次出现分组。此外，因为我已经将 x 的键设置为 a，并使用keyby，x[,.N,keyby=a]本身就是一个data.table，与x具有相同的键，所以x[ x[,.N,keyby=a] ]是一个data.tablejoin：它将内部table中的额外列N连接到外部列中。然后.(a,is.unique=N==1)是一个标准data.table对 select 两列列表的操作，尽管我很懒惰，没有使用不必要的括号。这也可以读作 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")
注意只有唯一值（蓝色）如何精确地落在格点上。我们可以将抖动调整为仅垂直抖动点，并且小于默认值：
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)
顺便说一下，不请自来的文体吹毛求疵：如果你给你的 color/fill 和形状标尺起相同的名字，它们就会结合起来，你可以有一个更好看的图例。例如：
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?")