Как создать временную спиральную диаграмму с использованием R

Ответ 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)

Теперь суммируем данные в 15-минутные временные бункеры со средним временем движения для каждого бункера и создаем переменную "спирального времени" для использования в качестве значения 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))

Ответ 2

Как я могу скачать этот шаблон? Я искал вечно, чтобы делать почасовую спираль днем, и это самое близкое, что я нашел, но не уверен, где находится ссылка для скачивания.