如何解决通过变量为sf LINESTRING上色
我想使用带有sf
和ggplot
的变量为geom_sf
LInesTRING的不同部分上色。我可以使用geom_path
做类似的事情,但是在geom_sf
中,类似的方法似乎行不通。有人可以提供一种可行的方法吗?
样本数据
library(sf)
library(ggplot2)
library(dplyr)
library(tibble)
df <- tibble(time = seq(1,21),lon = seq(-50,-30,1) + rnorm(n = 21),lat = seq(10,20,0.5) + rnorm(n = 21),type = c(rep('A',5),rep('B',10),rep('A',6)))
使用小节/数据框:
我可以使用小标题和基本ggplot来完成此工作,并合并group = 1
,然后将用type
着色的不同部分绘制一条直线。这是我要绘制的图,但改用sf
对象。
ggplot() +
geom_path(data = df,aes(lon,lat,color = type,group = 1))
使用sf
对象/ LInesTRING
如果我使用group_by
和type
投射到LInesTRING,我将得到两个LInesTRINGs
df_sf <- st_as_sf(df,coords = c('lon','lat')) %>%
st_set_crs(.,value = 4326) %>%
group_by(type) %>%
summarize(do_union = TRUE) %>%
st_cast(.,'LInesTRING')
然后,当我在下面的代码中执行变体时,我最终得到两条单独的行,并且将两个类型= A的部分连接在一起。
ggplot() +
geom_sf(data = df_sf,aes(color = type,group = 1))
是否有一种方法可以使用ggplot + geom_path()
方法来实现geom_sf()
类型的行为(以便我可以投影变量等)?
解决方法
我发现了一种将行划分为here段的方法,但是对于您的用例来说,这可能是过大的选择...
尝试一下:
df_sf <- df %>%
# ensure data is sorted along x-axis
arrange(lon) %>%
# detect each time type changes,& create a duplicate point with previous type
mutate(change.type = tidyr::replace_na(lag(type) != type,FALSE)) %>%
mutate(type = ifelse(change.type,paste(lag(type),type,sep = ";"),type) %>%
strsplit(";")) %>%
tidyr::unnest(cols = c(type)) %>%
# create new group column that increments with every colour change
mutate(change.type = tidyr::replace_na(lag(type) != type,FALSE)) %>%
mutate(new.type = cumsum(change.type)) %>%
st_as_sf(coords = c('lon','lat')) %>%
st_set_crs(.,value = 4326) %>%
# group by both original type (for colour) & new type (for group)
group_by(type,new.type) %>%
summarize(do_union = TRUE) %>%
st_cast(.,'LINESTRING') %>%
ungroup()
比较结果
cowplot::plot_grid(
ggplot() +
geom_path(data = arrange(df,lon),aes(lon,lat,color = type,group = 1),size = 1) +
ggtitle("geom_path approach") +
theme(legend.position = "bottom"),ggplot() +
geom_sf(data = df_sf,aes(color = type,group = new.type),size = 1) +
ggtitle("geom_sf approach") +
theme(legend.position = "bottom"),nrow = 1
)
数据:
set.seed(123)
df <- tibble(time = seq(1,21),lon = seq(-50,-30,1) + rnorm(n = 21),lat = seq(10,20,0.5) + rnorm(n = 21),type = c(rep('A',5),rep('B',10),rep('A',6)))
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。