Выберите и нанесите ночные часы между двумя днями на одном графике

Question

Я хочу нанести на график количество лиц, обнаруженных ночью, между 18 и 6 часами. Я не могу найти решение для представления этого на одном графике, принимая часы 18-00 часов 1-го дня и 00-6 часов второго дня. Есть идеи?

У меня есть данные такого типа (упрощенно):

year    site    id  date    hour
2018    A   1   24/07/2018  01:58:50
2018    A   2   24/07/2018  20:44:44
2018    A   2   24/07/2018  04:07:56
2018    A   1   25/07/2018  03:46:11
2018    A   2   25/07/2018  20:04:11
2018    A   2   25/07/2018  03:51:40
2018    A   1   26/07/2018  03:29:07
2018    A   2   26/07/2018  20:08:24
2018    A   2   26/07/2018  03:05:07
2018    A   1   27/07/2018  19:56:40
2018    A   1   27/07/2018  03:38:09
2018    A   2   27/07/2018  20:08:53
2018    A   2   27/07/2018  03:27:47
2018    A   1   28/07/2018  19:59:34
2018    A   1   28/07/2018  03:54:58
2018    A   2   28/07/2018  20:11:35

Я построил это с данными этого примера:

И я хотел бы что-то вроде этого:

А это мой код:

df <- read.table(text = "year    site    id  date    hour
2018    A   1   24/07/2018  01:58:50
2018    A   2   24/07/2018  20:44:44
2018    A   2   24/07/2018  04:07:56
2018    A   1   25/07/2018  03:46:11
2018    A   2   25/07/2018  20:04:11
2018    A   2   25/07/2018  03:51:40
2018    A   1   26/07/2018  03:29:07
2018    A   2   26/07/2018  20:08:24
2018    A   2   26/07/2018  03:05:07
2018    A   1   27/07/2018  19:56:40
2018    A   1   27/07/2018  03:38:09
2018    A   2   27/07/2018  20:08:53
2018    A   2   27/07/2018  03:27:47
2018    A   1   28/07/2018  19:59:34
2018    A   1   28/07/2018  03:54:58
2018    A   2   28/07/2018  20:11:35", header = TRUE)


df$DATETIME <- lubridate::dmy_hms(paste(df$date, df$hour))

list_comm <- split(df, df$site) # split for each site

bar_plots <- lapply(list_comm, function(x){

  #x <- list_comm[[1]]

  tab <- x %>%
    mutate(HOUR = as.numeric(strftime(DATETIME, format = "%H"))) %>%
    group_by(hour, date, year) %>%
    summarise(count = as.numeric(length(id))) %>%
    select(hour, date, year, count)

  tab %>%
    ggplot(aes(x = hour, y = count, fill = count))+
    geom_bar(stat="identity", position="dodge") +
    scale_x_continuous(breaks=c(0, 3,4,5, 12, 20, 21, 22, 23),
                       labels=c("00:00", "03:00", "04:00", "05:00", "12:00", "20:00", "21:00", "22:00", "23:00"),
                       limits=c(0,24)) +
    scale_fill_continuous(low="blue", high="red") +
    facet_wrap(date~. , ncol =1, scales="free_x") +
    labs(x = "Hour", y = "Number of passage", title = paste(unique(x$site), "-", unique(x$year))) +
    theme_classic() +
    theme(strip.text=element_text(hjust=0, face="bold")) +
    theme(panel.grid.major.x=element_blank()) +
    theme(panel.grid.minor=element_blank()) +
    theme(plot.margin=margin(30,30,30,30)) +
    theme(axis.text.x=element_text(angle = 90, vjust = 0.5, size = 8)) 

  ggsave(paste("results/04_movement_pattern/new_marked_individuals/barplot_pheno/2018-",unique(x$site),"panel_pheno_summer_sites.png"), width = 10, height=10, units = "in") #Save plot

} 
)

print(bar_plots)

Независимо от того, как сильно я ищу решение, я не могу его найти и теряюсь. Я приветствую любое предложение. заранее спасибо:)

Answer 1

Насколько я понимаю, проблема в том, что вы перепутали свои часовые переменные. Я предполагаю, что вы запланировали отобразить вашу непрерывную переменную HOUR на оси X. Вместо этого вы пытаетесь нанести категориальную символьную переменную hour на непрерывную шкалу, которая не будет работать. Чтобы добавить HOUR к вашему tab, я включил его в операторы group_by и select. Также, чтобы получить вид сюжета, я добавил преобразование HOUR. Попробуйте это:

df <- read.table(text = "year    site    id  date    hour
2018    A   1   24/07/2018  01:58:50
2018    A   2   24/07/2018  20:44:44
2018    A   2   24/07/2018  04:07:56
2018    A   1   25/07/2018  03:46:11
2018    A   2   25/07/2018  20:04:11
2018    A   2   25/07/2018  03:51:40
2018    A   1   26/07/2018  03:29:07
2018    A   2   26/07/2018  20:08:24
2018    A   2   26/07/2018  03:05:07
2018    A   1   27/07/2018  19:56:40
2018    A   1   27/07/2018  03:38:09
2018    A   2   27/07/2018  20:08:53
2018    A   2   27/07/2018  03:27:47
2018    A   1   28/07/2018  19:59:34
2018    A   1   28/07/2018  03:54:58
2018    A   2   28/07/2018  20:11:35", header = TRUE)

df$DATETIME <- lubridate::dmy_hms(paste(df$date, df$hour))

library(dplyr)
library(ggplot2)

list_comm <- split(df, df$site) # split for each site

bar_plots <- lapply(list_comm, function(x){

  x <- list_comm[[1]]

  tab <- x %>%
    mutate(HOUR = lubridate::hour(DATETIME)) %>%
    group_by(hour, date, year, HOUR) %>%
    summarise(count = as.numeric(length(id))) %>%
    select(hour, date, year, count, HOUR) %>% 
    mutate(HOUR1 = ifelse(HOUR >= 19 & HOUR <= 24, HOUR - 19, HOUR + 6))

  tab %>%
    ggplot(aes(x = HOUR1, y = count, fill = count))+
    geom_bar(stat="identity", position="dodge") +
    scale_x_continuous(breaks=0:10,
                       labels=c("19:00", "20:00", "21:00", "22:00", "23:00", "00:00", "01:00", "02:00", "03:00", "04:00", "05:00"),
                       limits=c(0, 10)) +
    scale_fill_continuous(low="blue", high="red") +
    facet_wrap(date~. , ncol =1, scales="free_x") +
    labs(x = "Hour", y = "Number of passage", title = paste(unique(x$site), "-", unique(x$year))) +
    theme_classic() +
    theme(strip.text=element_text(hjust=0, face="bold")) +
    theme(panel.grid.major.x=element_blank()) +
    theme(panel.grid.minor=element_blank()) +
    theme(plot.margin=margin(30,30,30,30)) +
    theme(axis.text.x=element_text(angle = 90, vjust = 0.5, size = 8)) 

} 
)
bar_plots$A
#> Warning: Removed 3 rows containing missing values (geom_bar).

^{Создано в 2020-04-21 пакетом Представить (v0.3.0)}

Answer 2

Я решил эту проблему с помощью @ stefan

bar_plots <- lapply(list_comm, function(x){

  x <- list_comm[[1]]

  tab <- x %>%
    mutate(HOUR = lubridate::hour(DATETIME)) %>%
    group_by(date) %>%
    slice(which(!(date == x$date[1] & HOUR < 19))) %>% #remove morning hour of the first day of capture 
    group_by(hour, date, year, HOUR) %>%
    summarise(count = as.numeric(length(id))) %>%
    select(hour, date, year, count, HOUR) %>% 
    mutate(HOUR1 = ifelse(HOUR >= 19 & HOUR <= 24, HOUR - 19, HOUR + 6)) %>% #to inverse the x axis 
    ungroup() %>%
    mutate(date = lubridate::dmy(date) - lubridate::days(if_else(HOUR >= 12, 0, 1))) #for hours between 0 to 12 you set the date to yesterday. This way you group hours 12 to 24 from today with hours 0 to 12 from tomorrow

  #Pass to english format to plot  
  Sys.setlocale("LC_TIME", "English")

 tab %>%
   mutate(date = paste(lubridate::day(date), "to", lubridate::day(lubridate::date(tab$date)+1), lubridate::month(date, label=TRUE, abbr = FALSE),lubridate::year(date))) %>%
    ggplot(aes(x = HOUR1, y = count, fill = count))+
    geom_bar(stat="identity", position="dodge") +
    scale_x_continuous(breaks=0:10,
                       labels=c("19:00", "20:00", "21:00", "22:00", "23:00", "00:00", "01:00", "02:00", "03:00", "04:00", "05:00"),
                       limits=c(0, 10)) +
    scale_fill_continuous(low="blue", high="red") +
    facet_wrap(date~. , ncol =1, scales="free_x") +
    labs(x = "Hour", y = "Number of passage", title = paste(unique(x$site), "-", unique(x$year))) +
    theme_classic() +
    theme(strip.text=element_text(hjust=0, face="bold")) +
    theme(panel.grid.major.x=element_blank()) +
    theme(panel.grid.minor=element_blank()) +
    theme(plot.margin=margin(30,30,30,30)) +
    theme(axis.text.x=element_text(angle = 90, vjust = 0.5, size = 8)) 

} 
)
bar_plots$A

Это продукты:

Очень полезно для мой анализ ночной деятельности :)