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

Question

有什么方法可以在R中绘制这样的图形并在其上具有相同的12个轴并带有其名称？

这是图表的图片。


这是我的数据

        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

这是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")

这是我5天的数据

Data1



这是另一个显示时间螺旋的图形。您可以将图形更改为螺旋形，而不是圆形吗？



我从这个链接得到图
here

Answer 1

总体方法是将数据汇总到时间段中（我使用了15分钟的时间段），其中每个时间段的值是该时间段内值的平均行进时间。然后，我们将POSIXct日期用作y值，以便图形随时间向外螺旋旋转。使用geom_rect，我们将平均行进时间映射到条形高度以创建螺旋形条形图。

首先，加载和处理数据：

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)

现在，将数据汇总为1​​5分钟的时段（每个时段的平均旅行时间），并创建一个“螺旋时间”变量以用作y值：

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)

最后，绘制数据。每个每小时15分钟的时段都有自己的时段，我们将行进时间用于颜色渐变和条形的高度。当然，您可以根据需要将填充颜色和条形高度映射到两个不同的变量（在示例中，填充颜色映射到月；如果要突出显示，则可以将数据映射到日期） 。

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

以下是其他两个版本：第一个使用 geom_segment，因此，仅将旅行时间映射为填充颜色。第二个使用 geom_tile并将行进时间映射到填充颜色和图块高度。

geom_segment版本

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版本

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