Delimit periods

Packages: dplyr, ggplot2

Delimit weeks

Delimit using colors

data %>%
  filter(id == 1) %>%
  ggplot(aes(x=obsno,y=PA1, color=factor(daycum))) +
    geom_path(aes(group=1)) +
    geom_point() 

Delimit using lines

data_pp = data %>% filter(id == 1)
min_ = floor_date(min(data_pp$sent), unit="day")
max_ = floor_date(max(data_pp$sent), unit="day")
dates = seq(min_, max_, "day")
week_ints = dates[wday(dates) == 2]
data_pp %>% 
  ggplot(aes(x=sent, y=PA1)) +
    geom_line() +
    geom_point() +
    geom_vline(xintercept=week_ints, color="blue")

min_ = floor_date(min(data$sent), unit="day")
max_ = floor_date(max(data$sent), unit="day")
dates = seq(min_, max_, "day")
week_ints = as.Date(dates[wday(dates) == 2])

data = data %>%
  mutate(week = ifelse(as.Date(sent) %in% week_ints & !lag(as.Date(sent)) %in% week_ints, obsno, NA))

data = data %>% 
    group_by(id) %>%
    mutate(weekcum = difftime(floor_date(sent, 'week'), as.Date(min(sent, na.rm=TRUE)), units="weeks") + 1)

data = data %>% arrange(id, sent) %>%
    group_by(id, weekcum) %>%
    mutate(obsnoweek = 1:n(), obsnoweek_inv = n():1)

obsno_week = ifelse(data$beepperiod == 1 | data$beepperiod_inv == 1, data$obsno, NA) 


data %>% filter(id <= 15) %>%
  ggplot( aes(x=obsno, y=PA1)) +
    geom_line() +
    geom_point() +
    geom_vline(aes(xintercept=week), color="blue", size=1) +
    facet_wrap(.~id)

Delimit weekend

Delimit using colors

data %>%
  filter(id == 1) %>%
  mutate(wday = ifelse(wday(sent) %in% c(1,7), "weekend", "weekday")) %>%
  ggplot(aes(x=obsno,y=PA1, color=factor(wday))) +
    geom_path(aes(group=1)) +
    geom_point() 

WITH LINES:

For one person

min_ = floor_date(min(data_pp$sent), unit="day")
max_ = floor_date(max(data_pp$sent), unit="day")
dates = seq(min_, max_, "day")
week_ints = dates[wday(dates) %in% c(2,7)]

data_pp %>% 
  ggplot( aes(x=sent, y=PA1)) +
    geom_line(color="#69b3a2") +
    geom_point() +
    geom_vline(xintercept=week_ints, color="blue")

For everyone in the dataset

min_ = floor_date(min(data$sent), unit="day")
max_ = floor_date(max(data$sent), unit="day")
dates = seq(min_, max_, "day")
weekend_end = as.Date(dates[wday(dates) == 1])
weekend_start = as.Date(dates[wday(dates) == 7])

data = data %>% 
    group_by(id) %>%
    mutate(daycum = difftime(as.Date(sent), as.Date(min(sent, na.rm=TRUE)), units="days") + 1) %>%
    group_by(id,daycum) %>%
    mutate(obsnoday = 1:n(), obsnoday_inv = n():1)

first_beep = data$obsno == 1
max_beep = data$obsno == 70
start_weekend = as.Date(data$sent) %in% weekend_start & data$obsnoday == 1
end_weekend = as.Date(data$sent) %in% weekend_end & data$obsnoday_inv == 1
obsno_week = ifelse(first_beep | max_beep | start_weekend | end_weekend, data$obsno, NA) 
df_ = data.frame(id=data$id, sent=data$sent, start=obsno_week) %>%
  filter(!is.na(start)) %>%
  group_by(id) %>%
  mutate(end = lead(start),
         color = ifelse(wday(sent) %in% c(1:5,7), "red", "blue")) %>% #TODO: it is weird that it is 1 and 7 (issue?)
  filter(!is.na(end))

id_ = 1
df_id = df_ %>% filter(id == id_)
data_id = data %>% filter(id == id_)

ggplot() +
  geom_line(color="#69b3a2") +
  geom_rect(data = df_id, aes(xmin = start, xmax = end, ymin = - Inf, ymax = Inf, fill = color), alpha = 0.5) +
  geom_point(data=data_id, aes(x=obsno, y=PA1)) +
  geom_line(data=data_id, aes(x=obsno, y=PA1))

ggplot() +
  geom_line(color="#69b3a2") +
  geom_rect(data = df_, aes(xmin = start, xmax = end, ymin = - Inf, ymax = Inf, fill = color), alpha = 0.5) +
  geom_point(data=data, aes(x=obsno, y=PA1)) +
  geom_line(data=data, aes(x=obsno, y=PA1)) + 
  facet_wrap(.~id) 

Delimit days

data = data %>% arrange(id, sent) %>%
    group_by(id,daycum) %>%
    mutate(obsnoday = 1:n(), obsnoday_inv = n():1)

obsno_week = ifelse(data$obsnoday == 1 | data$obsnoday_inv == 1, data$obsno, NA) 

df_ = data.frame(id=data$id, sent=data$sent, daycum=data$daycum, start=obsno_week) %>%
  filter(!is.na(start)) %>%
  group_by(id) %>%
  mutate(end = lead(start)) %>%
  filter(!is.na(end)) %>%
  mutate(color = ifelse(as.numeric(daycum) %% 2 == 1, "red", "blue"))

id_ = 1
df_id = df_ %>% filter(id == id_)
data_id = data %>% filter(id == id_)

ggplot() +
  geom_line(color="#69b3a2") +
  geom_rect(data = df_id, aes(xmin = start, xmax = end, ymin = - Inf, ymax = Inf, fill = color), alpha = 0.5) +
  geom_point(data=data_id, aes(x=obsno, y=PA1)) +
  geom_line(data=data_id, aes(x=obsno, y=PA1)) 

ggplot() +
  geom_line(color="#69b3a2") +
  geom_rect(data = df_, aes(xmin = start, xmax = end, ymin = - Inf, ymax = Inf, fill = color), alpha = 0.5) +
  geom_point(data=data, aes(x=obsno, y=PA1)) +
  geom_line(data=data, aes(x=obsno, y=PA1)) + 
  facet_wrap(.~id) 

period in a day

library(hms)
data$period = case_when(as_hms(data$sent) < as_hms("12:00:00") ~ "morning",
                        as_hms(data$sent) < as_hms("18:00:00") ~ "afternoon",
                        as_hms(data$sent) < as_hms("24:00:00") ~ "evening")

data = data %>% arrange(id, sent) %>%
    group_by(id, daycum, period) %>%
    mutate(beepperiod = 1:n(), beepperiod_inv = n():1)


obsno_week = ifelse(data$beepperiod == 1 | data$beepperiod_inv == 1, data$obsno, NA) 

df_ = data.frame(id=data$id, sent=data$sent, period=data$period, start=obsno_week) %>%
  filter(!is.na(start)) %>%
  group_by(id) %>%
  mutate(end = lead(start)) %>%
  filter(!is.na(end)) %>%
  mutate(color = case_when(period == "morning" ~ "red",
                           period == "afternoon" ~ "blue",
                           period == "evening" ~ "green"))

id_ = 1
df_id = df_ %>% filter(id == id_)
data_id = data %>% filter(id == id_)

ggplot() +
  geom_line(color="#69b3a2") +
  geom_rect(data = df_id, aes(xmin = start, xmax = end, ymin = - Inf, ymax = Inf, fill = color), alpha = 0.5) +
  geom_point(data=data_id, aes(x=obsno, y=PA1)) +
  geom_line(data=data_id, aes(x=obsno, y=PA1)) 

ggplot() +
  geom_line(color="#69b3a2") +
  geom_rect(data = df_, aes(xmin = start, xmax = end, ymin = - Inf, ymax = Inf, fill = color), alpha = 0.5) +
  geom_point(data=data, aes(x=obsno, y=PA1)) +
  geom_line(data=data, aes(x=obsno, y=PA1)) + 
  facet_wrap(.~id)