时间块覆盖热图数据重塑答案

【问题标题】：time block coverage heat map data reshaping时间块覆盖热图数据重塑
【发布时间】：2019-07-11 20:38:48
【问题描述】：

我正在尝试使用非常奇怪的数据结构创建热图

您可以使用以下代码生成一些示例数据（诚然效率非常低）：

times<-sort(format(seq.POSIXt(as.POSIXct(Sys.Date()),as.POSIXct(Sys.Date()+1),by = "5 min"),"%H%M"))
set.seed(922)
sample.data<-as.data.frame(matrix(NA,nrow = 2000,ncol = 10))
names(sample.data)<-c("INDEX","DAY1","START1","END1","DAY2","START2","END2","DAY3","START3","END3")
for(i in 1:nrow(sample.data)){
  sample.data[i,"INDEX"]<-sample(1:100,1,replace = T)
  sample.data[i,"DAY1"]<-sample(c("Monday","Tuesday","Wednesday","Thursday","Friday","Saturday"),1,replace = F)
  sample.data[i,"START1"]<-sample(times,1,replace = T)
  sample.data[i,"END1"]<-sample(times,1,replace = T)
  sample.data[i,"DAY2"]<-sample(c("Monday","Tuesday","Wednesday","Thursday","Friday","Saturday"),1,replace = F)
  sample.data[i,"START2"]<-sample(times,1,replace = T)
  sample.data[i,"END2"]<-sample(times,1,replace = T)
  sample.data[i,"DAY3"]<-sample(c("Monday","Tuesday","Wednesday","Thursday","Friday","Saturday"),1,replace = F)
  sample.data[i,"START3"]<-sample(times,1,replace = T)
  sample.data[i,"END3"]<-sample(times,1,replace = T)
}

data<-sample.data%>%
  filter(START1<END1 & START2<END2 & START3<END3 & DAY1!=DAY2 & DAY1!=DAY3 & DAY2!=DAY3)

我知道它丑陋且效率低下，但数据大致是这种结构。您可以将其视为您在任何给定时间在机场所说的员工人数，其中每一行是员工的轮班时间。

我想创建一个热图，其中一天中的时间在 y 轴上分为 5 分钟段，在 x 轴上分为一周中的几天。我是否必须按 5 分钟的时间块收集列和分组？我不知道。

如果数据结构正确，我可以按工作日和不同的 5 分钟数据块进行分组，并对机场有观察单元的每一行进行统计。我只是不知道我将如何让 dplyr 说有人在工作而没有明确指出它，而且我不知道如果没有 for 循环该怎么做。如果我需要更好地解释我想要做什么，或者如果您对如何以正确的形式获取我的数据有任何好主意，或者如果我什至以正确的方式考虑这个问题，请告诉我。我一直把头撞在桌子上，我需要离开这个问题一分钟，但如果它有帮助，那么如果你执行以下绘图代码，热图应该会出来：

ggplot(data, aes(x = DAY, y = TIME_CHUNK))+
geom_tile(aes(fill = TOTAL_EMPLOYEES))+
geom_text(aes(label = TOTAL_EMPLOYEES), colour = "white",size = 3)

感谢您的宝贵时间...

【问题讨论】：

标签： r dplyr heatmap

【解决方案1】：

这是一个部分解决方案，可以实现大部分目标。以后有时间我会努力完成的。

首先，我将使用此处的技术重塑数据：https://stackoverflow.com/a/56605646/6851825

DAY <- grep("DAY", names(data))
START_END <- grep("START|END", names(data))
data_long <- cbind(stack(data, select = DAY), stack(data, select = START_END))
names(data_long) <- c("WEEKDAY", "DAYNUM", "TIME", "STATUS")

在这里，我将进行更多的整形以排序工作日并将 TIME 转换为小数，并跟踪累积计数

library(tidyverse)
data_long_count <- data_long %>%
mutate(WEEKDAY = factor(WEEKDAY, levels = c("Sunday", "Monday", "Tuesday", 
                          "Wednesday", "Thursday", "Friday", "Saturday")),
       TIME_dec = as.numeric(TIME %>% str_sub(end = 2)) +
         as.numeric(TIME %>% str_sub(start = 3))/60,
       STATUS = STATUS %>% str_remove("[0-9]"),
       count_chg = if_else(STATUS == "START", 1, -1)) %>%
arrange(WEEKDAY, TIME_dec) %>%
mutate(employee_count = cumsum(count_chg))

[缺少步骤：填写所有分钟，没有变化。打算为此使用padr 包，但它更喜欢使用datetime 或date。或者可以使用 geom_rect 来回避。]

如果没有其中任何一个，这个热图是“参差不齐”的 b/c，它只有在发生变化的地方有条纹，而不是中间的所有分钟。

ggplot(data_long_count, aes(WEEKDAY, TIME_dec, fill = employee_count)) + geom_tile()

【讨论】：

【解决方案2】：

我认为应该这样做

clean_colnames <- function(col_inds) {
  data %>% select(INDEX, day = col_inds[1], start = col_inds[2], end = col_inds[3])
}

bind_rows(clean_colnames(2:4), clean_colnames(5:7), clean_colnames(8:10))  %>% 
  gather(key = start_end, value = time, -INDEX, -day) %>% 
  mutate(time = paste0("20190101 ", time) %>% lubridate::ymd_hm()) %>% 
  padr::pad(group = c("INDEX", "day")) %>% 
  count(day, time) %>% 
  mutate(time = paste0(substr(time, 12, 13), substr(time, 15, 16)))

【讨论】：