How to Create A Time-Spiral Graph Using R

2019-01-22 14:27发布

问题:

is there any way to plot a graph like this in R and have the same 12 axes on it with thier name ?

here's a pic for the graph.

here's a piece of my data

        Date1  Time TravelTime
1  2016-09-04 13:11         34
2  2016-09-04 13:12         34
3  2016-09-04 13:13         33
4  2016-09-04 13:14         33
5  2016-09-04 13:15         33
6  2016-09-04 13:16         43
7  2016-09-04 13:17         44
8  2016-09-04 13:18         44
9  2016-09-04 13:19         40
10 2016-09-04 13:20         39

here's the output from dput

structure(list(Date1 = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L), .Label = "2016-09-04", class = "factor"), Time = structure(1:10, .Label = c("13:11", 
"13:12", "13:13", "13:14", "13:15", "13:16", "13:17", "13:18", 
"13:19", "13:20"), class = "factor"), TravelTime = c(34L, 34L, 
33L, 33L, 33L, 43L, 44L, 44L, 40L, 39L)), .Names = c("Date1", 
"Time", "TravelTime"), row.names = c(NA, -10L), class = "data.frame")

here's my data for 5 days

Data1


here's another graph that shows the Time-Spiral ... May you please change your graph to spiral, not a circular ?

i got the graph from this link here

回答1:

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))