Forcing the Time Axes to be set at a specific boundaries-CodePudding

Here is what I have now:

graph_POST %>%
  mutate(day = lubridate::day(Date)) %>%
  pivot_longer(Standing:New_Sitting, names_to = "Posture") %>%
ggplot(aes(x = Time, y = value, color = Posture)) 
  geom_point(size=0.5) 
  scale_y_continuous(limits = c(0.5,4.5), expand = expansion(0))  
  facet_wrap(~day, scales = "free_x")  
  labs(title = "Posture vs. Time (POST)")  
  theme(axis.title.y = element_blank(),
        axis.text.y = element_blank(),
        panel.grid.major.y = element_blank(),
        panel.grid.minor.y = element_blank())

I need the x axes to be the same for all my plots in my "facet" (8am-5pm) with a tick every hour. I've tried to do similar to my y axes, but it seems to not like that for some reason:scale_x_continuous(limits = c(8:00,5:00))

My Output so far:

Please let me know if you have any questions or need clarifications

> dput(head(graph_POST,30))
structure(list(Date = structure(c(19145, 19145, 19145, 19145, 
19145, 19145, 19145, 19145, 19145, 19145, 19145, 19145, 19145, 
19145, 19145, 19145, 19145, 19145, 19145, 19145, 19145, 19145, 
19145, 19145, 19145, 19145, 19145, 19145, 19145, 19145), class = "Date"), 
    Time = structure(c(1654182900, 1654182901, 1654182902, 1654182903, 
    1654182904, 1654182905, 1654182906, 1654182907, 1654182908, 
    1654182909, 1654182910, 1654182911, 1654182912, 1654182913, 
    1654182914, 1654182915, 1654182916, 1654182917, 1654182918, 
    1654182919, 1654182920, 1654182921, 1654182922, 1654182923, 
    1654182924, 1654182925, 1654182926, 1654182927, 1654182928, 
    1654182929), class = c("POSIXct", "POSIXt"), tzone = ""), 
    Axis1 = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), Axis2 = c(0, 0, 
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
    0, 0, 0, 0, 0, 0, 0, 0, 0), Axis3 = c(0, 0, 0, 0, 0, 0, 0, 
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
    0, 0, 0, 0), VM = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), Standing = c(0, 
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0), Stepping = c(0, 0, 0, 0, 0, 
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
    0, 0, 0, 0, 0, 0), Cycling = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
    0, 0), New_Sitting = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 
    1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1), Counter = c(0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L)), row.names = c(NA, 
30L), class = "data.frame")

EDIT

graph_POST %>%
  mutate(day = lubridate::day(Date)) %>%
  pivot_longer(Standing:New_Sitting, names_to = "Posture") %>%
  ggplot(aes(x = Time, y = value, color = Posture))  
  geom_point(data = data.frame(
    Time = as.POSIXct(rep(unique(graph_POST$Date), 2))  
           rep(c(8, 17) * 3600, each = length(unique(graph_POST$Date))),
    value = 1, Posture = "Cycling", 
    day = rep(lubridate::day(unique(graph_POST$Date)), 2)), alpha = 0)  
  geom_point(size=0.5) 
  scale_y_continuous(limits = c(0.5,4.5), expand = expansion(0))  
  scale_x_datetime(date_labels = "%H:%M",
                   breaks = rep(as.POSIXct(unique(graph_POST$Date)), 4)  
                     rep(c(8, 11, 14, 17) * 3600, 
                         each = length(unique(graph_POST$Date))))  
  facet_wrap(~day, scales = "free_x")  
  labs(title = "Posture vs. Time (POST)")  
  theme(axis.title.y = element_blank(),
        axis.text.y = element_blank(),
        panel.grid.major.y = element_blank(),
        panel.grid.minor.y = element_blank())

CodePudding user response：

You can use the old "add invisible points at 8am and 5pm in each facet" trick. This is a bit of a pain in this case because the faceting variable is completely correlated with the x axis. The code is also a bit longer than it had to be because I thought it would be better to put labels at exactly 08:00 and 17:00.

Note that your sample data only included a single day's data which means the problem isn't reproducible. I have therefore created a compatible data set for illustration (see below)

graph_POST %>%
  mutate(day = lubridate::day(Date)) %>%
  pivot_longer(Standing:New_Sitting, names_to = "Posture") %>%
  ggplot(aes(x = Time, y = value, color = Posture))  
  geom_point(data = data.frame(
    Time = as.POSIXct(rep(unique(graph_POST$Date), 2))  
           rep(c(8, 17) * 3600, each = length(unique(graph_POST$Date))),
    value = 1, Posture = "Cycling", 
    day = rep(lubridate::day(unique(graph_POST$Date)), 2)), alpha = 0)  
  geom_point(size=0.5) 
  scale_y_continuous(limits = c(0.5,4.5), expand = expansion(0))  
  scale_x_datetime(date_labels = "%H:%M",
                   breaks = rep(as.POSIXct(unique(graph_POST$Date)), 4)  
                     rep(c(8, 11, 14, 17) * 3600, 
                         each = length(unique(graph_POST$Date))))  
  facet_wrap(~day, scales = "free_x")  
  labs(title = "Posture vs. Time (POST)")  
  theme(axis.title.y = element_blank(),
        axis.text.y = element_blank(),
        panel.grid.major.y = element_blank(),
        panel.grid.minor.y = element_blank())

Reproducible data

set.seed(1)

graph_POST <- data.frame(Date = rep(as.Date(
  c("2022-06-02", "2022-06-03", "2022-06-06", "2022-06-07", "2022-06-08")),
  each = 100),
  Time = as.POSIXct(rep(as.Date(
  c("2022-06-02", "2022-06-03", "2022-06-06", "2022-06-07", "2022-06-08")),
  each = 100))   sample(32000:61200, 500),
  Standing = sample(c(0, 4), 500, TRUE, prob = c(4, 1)),
  Stepping = sample(c(0, 3), 500, TRUE, prob = c(4, 1)),
  Cycling = sample(c(0, 2), 500, TRUE, prob = c(4, 1)),
  New_Sitting = sample(0:1, 500, TRUE, prob = c(4, 1)))

CodePudding user response：

If you are faceting by day anyways, and only showing time on the x axis, then the time variable does not need to be in a datetime class. You can just convert it to continuous data first, and then the whole shebang becomes really simple.

Using Allan's data. (thanks)

library(tidyverse)
set.seed(1)

graph_POST <- data.frame(Date = rep(as.Date(
  c("2022-06-02", "2022-06-03", "2022-06-06", "2022-06-07", "2022-06-08")),
  each = 100),
  Time = as.POSIXct(rep(as.Date(
    c("2022-06-02", "2022-06-03", "2022-06-06", "2022-06-07", "2022-06-08")),
    each = 100))   sample(32000:61200, 500),
  Standing = sample(c(0, 4), 500, TRUE, prob = c(4, 1)),
  Stepping = sample(c(0, 3), 500, TRUE, prob = c(4, 1)),
  Cycling = sample(c(0, 2), 500, TRUE, prob = c(4, 1)),
  New_Sitting = sample(0:1, 500, TRUE, prob = c(4, 1)))

graph_POST %>%
  mutate(day = lubridate::day(Date), 
         hour = as.integer(format(Time,"%H")), 
## If you need it precise to the minute
         minute = as.integer(format(Time,"%M")) ,
         hour_minute = hour   minute/60) %>%
  pivot_longer(Standing:New_Sitting, names_to = "Posture") %>%
  ggplot(aes(x = hour_minute, y = value, color = Posture))  
  geom_point()  
  facet_wrap(~day)  
  ## now setting the limits is easy.
  scale_x_continuous(breaks= 8:17, limits = c(8, 17)) 
#> Warning: Removed 252 rows containing missing values (geom_point).