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)
根據菲利普的回答更新我做了這樣的事情：
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)
OUTPUT
1 個解決方案
解決方案1
3 已采納 2016-02-29 21:32:32
嘗試使用geom_jitter而不是geom_point 。 您可以指定width和height來調整抖動量。
從文檔：
width垂直和水平抖動量。 抖動在正方向和負方向上相加，因此總擴展量是此處指定值的兩倍。 如果省略，則默認為數據分辨率的40％：這意味着抖動值將占據隱含箱的80％。 分類數據在整數上對齊，因此0.5的寬度或高度將分散數據，因此無法看到類別之間的區別。
height垂直和水平抖動量。 抖動在正方向和負方向上相加，因此總擴展量是此處指定值的兩倍。 如果省略，則默認為數據分辨率的40％：這意味着抖動值將占據隱含箱的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中，因此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
現在我們可以根據數據是否過度分離來繪制一個圖表（注意這個數據沒有字面意思，因為在這里我將所有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?")
使用 alpha 來減少 R package ggplot2 中的過度繪圖時，運行時顯着膨脹
[英]significant runtime inflation when using alpha to reduce over-plotting in the R package ggplot2
聲明:本站的技術帖子網頁，遵循CC BY-SA 4.0協議，如果您需要轉載，請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.