通过变量为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)))