在 ggplot2 中繪制日期間隔

Question

我有一個數據集，它有一堆日期間隔（即 POSIXct 格式的開始日期和結束日期）。

在提供的示例中，假設每個時期都與某人上學或失學的時間相關聯。 我有興趣在 ggplot2 中繪制數據，每一行本質上是一個時期的數據。 目前所有的行都沒有因子變量，但我在示例中放了一個，因為它可能會使 plot 的事情變得更容易。 值得注意的是，在某些情況下，一個時期的結束日期和下一個時期的開始重疊。

在數據中，每一行都是與特定時期相關的在校時期。 我有興趣在 x 軸和 y 軸上創建一個周序列（從數據集中的第一周到最后一周），我希望每周都有一個點來表示該人是否在學校（也確定哪個時間段）或失學（甚至可能就足夠了）。 因此，在這種情況下，可能需要一個 8 級因子，一個用於每個時期，一個用於失學的水平（或者也許在失學時不需要任何水平）？

所以在這種情況下，我們可以設想在 y 軸上有 7 行點，像這樣（非常松散地）（這個例子有很多線間隙，但我預計很少或沒有間隙）。

我設想這個過程類似於：創建一個從 min(start_date) 到 max(end_date) 的序列，將行連接到這個序列。 然后以某種方式識別每個時期並為每個時期創建一個因子變量。 然后 plot 針對日期序列的因子變量（例如 period1、period2、period3）。 我無法做到這一點，因為它非常繁瑣。

看着 lubridate package 我在想使用 interval() 和 %within% 可能是解決方案，但我不確定。

library(tidyverse)
library(lubridate)
                              
start_dates = ymd_hms(c("2019-05-08 00:00:00",
                        "2020-01-17 00:00:00",
                        "2020-03-03 00:00:00",
                        "2020-05-28 00:00:00",
                        "2020-12-10 00:00:00",
                        "2021-05-07 00:00:00",
                        "2022-01-04 00:00:00"), tz = "UTC")
  
end_dates = ymd_hms(c( "2019-10-24 00:00:00",
                       "2020-03-03 00:00:00", 
                       "2020-05-28 00:00:00",
                       "2020-12-10 00:00:00",
                       "2021-05-07 00:00:00",
                       "2022-01-04 00:00:00",
                       "2022-01-19 00:00:00"), tz = "UTC") 

df = data.frame(studying = paste0("period",seq(1:7),sep = ""),start_dates,end_dates)
 

Answer 1

你可以試試

df %>% 
  ggplot() + 
   geom_segment(aes(x = start_dates, xend = end_dates, y =studying, yend = studying, color = studying), size=3) + 
  geom_segment(aes(x = start_dates, xend = start_dates, y =0, yend = studying))+
  geom_segment(aes(x = end_dates, xend = end_dates, y =0, yend = studying))

正如你在評論中所問的那樣

df %>% 
  as_tibble() %>%
  mutate(start = week(start_dates),
         end = week(end_dates)) %>% 
  mutate(gr = start>end, 
         start_2 = ifelse(gr, 0, NA),
         end_2 = ifelse(gr, end, NA),
         end = ifelse(gr, 52, end)) %>% 
  select(-2:-3, -gr) %>% 
  pivot_longer(-1) %>% 
  filter(!is.na(value)) %>% 
  separate(col = name, into = c("name", "index"), sep = "_", fill = "right") %>%  
  mutate(index = ifelse(is.na(index), 1, index)) %>% 
  pivot_wider(names_from = "name", values_from = "value") %>% 
  ggplot(aes(y=studying , yend=studying , x=start, xend=end, color=studying)) + 
   geom_segment(size = 2)

要獲得重疊，您可以使用valr package。 由於它是為了發現 DNA 片段中的重疊而開發的，因此數據需要進行一些轉換。 開始結束結束使用 cumsum week 方法計算。 色度設置為"1" 。

library(valr)
df %>% 
  as_tibble() %>%
  mutate(start = week(start_dates) + (year(start_dates)-min(year(start_dates)))*52,
         end = week(end_dates) + (year(end_dates)-min(year(end_dates)))*52,
         chrom="1", 
         index=1:n()) %>%  
  valr::bed_intersect(., .) %>% 
  filter(studying.x != studying.y) %>% 
  # filter duplicated intervals out
  mutate(index = paste(index.x, index.y) %>% str_split(., " ") %>% map(sort) %>% map_chr(toString)) %>% 
  filter(duplicated(index))

# A tibble: 5 x 15
  studying.x start_dates.x end_dates.x start.x end.x chrom index.x studying.y start_dates.y end_dates.y start.y end.y index.y .overlap index
  <chr>              <dbl>       <dbl>   <dbl> <dbl> <chr>   <int> <chr>              <dbl>       <dbl>   <dbl> <dbl>   <int>    <int> <chr>
1 period3       1583193600  1590624000      61    74 1           3 period2       1579219200  1583193600      55    61       2        0 2, 3 
2 period4       1590624000  1607558400      74   102 1           4 period3       1583193600  1590624000      61    74       3        0 3, 4 
3 period5       1607558400  1620345600     102   123 1           5 period4       1590624000  1607558400      74   102       4        0 4, 5 
4 period6       1620345600  1641254400     123   157 1           6 period5       1607558400  1620345600     102   123       5        0 5, 6 
5 period7       1641254400  1642550400     157   159 1           7 period6       1620345600  1641254400     123   157       6        0 6, 7