且构网

分享程序员开发的那些事...
且构网 - 分享程序员编程开发的那些事

如何使用R创建时间螺旋图

更新时间:2023-11-18 09:27:52

The overall approach is to summarize the data into time bins (I used 15-minute bins), where each bin's value is the average travel time for values within that bin. Then we use the POSIXct date as the y-value so that the graph spirals outward with time. Using geom_rect, we map average travel time to bar height to create a spiral bar graph.

First, load and process the data:

library(dplyr)
library(readxl)
library(ggplot2)

dat = read_excel("Data1.xlsx")

# Convert Date1 and Time to POSIXct
dat$time = with(dat, as.POSIXct(paste(Date1, Time), tz="GMT"))

# Get hour from time
dat$hour = as.numeric(dat$time) %% (24*60*60) / 3600

# Get date from time
dat$day =  as.Date(dat$time)

# Rename Travel Time and convert to numeric
names(dat)[grep("Travel",names(dat))] = "TravelTime"
dat$TravelTime = as.numeric(dat$TravelTime)

Now, summarize the data into 15-minute time-of-day bins with the mean travel time for each bin and create a "spiral time" variable to use as the y-value:

dat.smry = dat %>% 
  mutate(hour.group = cut(hour, breaks=seq(0,24,0.25), labels=seq(0,23.75,0.25), include.lowest=TRUE),
         hour.group = as.numeric(as.character(hour.group))) %>%
  group_by(day, hour.group) %>%
  summarise(meanTT = mean(TravelTime)) %>%
  mutate(spiralTime = as.POSIXct(day) + hour.group*3600)

Finally, plot the data. Each 15-minute hour-of-day bin gets its own segment, and we use travel time for the color gradient and the height of the bars. You could of course map fill color and bar height to two different variables if you wish (in your example, fill color is mapped to month; with your data, you could map fill color to date, if that is something you want to highlight).

ggplot(dat.smry, aes(xmin=as.numeric(hour.group), xmax=as.numeric(hour.group) + 0.25, 
                     ymin=spiralTime, ymax=spiralTime + meanTT*1500, fill=meanTT)) +
  geom_rect(color="grey40", size=0.2) +
  scale_x_continuous(limits=c(0,24), breaks=0:23, minor_breaks=0:24,
                     labels=paste0(rep(c(12,1:11),2), rep(c("AM","PM"),each=12))) +
  scale_y_datetime(limits=range(dat.smry$spiralTime) + c(-2*24*3600,3600*19), 
                   breaks=seq(min(dat.smry$spiralTime),max(dat.smry$spiralTime),"1 day"),
                   date_labels="%b %e") +
  scale_fill_gradient2(low="green", mid="yellow", high="red", midpoint=35) +
  coord_polar() +
  theme_bw(base_size=13) + 
  labs(x="Hour",y="Day",fill="Mean Travel Time") +
  theme(panel.grid.minor.x=element_line(colour="grey60", size=0.3))

Below are two other versions: The first uses geom_segment and, therefore, maps travel time only to fill color. The second uses geom_tile and maps travel time to both fill color and tile height.

geom_segment version

ggplot(dat.smry, aes(x=as.numeric(hour.group), xend=as.numeric(hour.group) + 0.25, 
                     y=spiralTime, yend=spiralTime, colour=meanTT)) +
  geom_segment(size=6) +
  scale_x_continuous(limits=c(0,24), breaks=0:23, minor_breaks=0:24,
                     labels=paste0(rep(c(12,1:11),2), rep(c("AM","PM"),each=12))) +
  scale_y_datetime(limits=range(dat.smry$spiralTime) + c(-3*24*3600,0), 
               breaks=seq(min(dat.smry$spiralTime), max(dat.smry$spiralTime),"1 day"),
               date_labels="%b %e") +
  scale_colour_gradient2(low="green", mid="yellow", high="red", midpoint=35) +
  coord_polar() +
  theme_bw(base_size=10) + 
  labs(x="Hour",y="Day",color="Mean Travel Time") +
  theme(panel.grid.minor.x=element_line(colour="grey60", size=0.3))

geom_tile version

ggplot(dat.smry, aes(x=as.numeric(hour.group) + 0.25/2, xend=as.numeric(hour.group) + 0.25/2, 
                     y=spiralTime, yend=spiralTime, fill=meanTT)) +
  geom_tile(aes(height=meanTT*1800*0.9)) +
  scale_x_continuous(limits=c(0,24), breaks=0:23, minor_breaks=0:24,
                     labels=paste0(rep(c(12,1:11),2), rep(c("AM","PM"),each=12))) +
  scale_y_datetime(limits=range(dat.smry$spiralTime) + c(-3*24*3600,3600*9), 
                   breaks=seq(min(dat.smry$spiralTime),max(dat.smry$spiralTime),"1 day"),
                   date_labels="%b %e") +
  scale_fill_gradient2(low="green", mid="yellow", high="red", midpoint=35) +
  coord_polar() +
  theme_bw(base_size=12) + 
  labs(x="Hour",y="Day",color="Mean Travel Time") +
  theme(panel.grid.minor.x=element_line(colour="grey60", size=0.3))