ggplot2: график непрерывных длительностей времени как гистограмма

Question

Я использую ggplot для построения различных событий в зависимости от даты (по оси x) и времени начала (по оси Y), с которой они начали. Данные/код заключаются в следующем:

date<-c("2013-06-05","2013-06-05","2013-06-04","2013-06-04","2013-06-04","2013-06-04","2013-06-04", 
    "2013-06-04","2013-06-04","2013-06-03","2013-06-03","2013-06-03","2013-06-03","2013-06-03", 
    "2013-06-02","2013-06-02","2013-06-02","2013-06-02","2013-06-02","2013-06-02","2013-06-02") 
start <-c("07:36:00","01:30:00","22:19:00","22:12:00","20:16:00","19:19:00","09:00:00", 
    "06:45:00","01:03:00","22:15:00","19:05:00","08:59:00","08:01:00","07:08:00", 
    "23:24:00","20:39:00","18:53:00","16:57:00","15:07:00","14:33:00","13:24:00") 
duration <-c(0.5,6.1,2.18,0.12,1.93,0.95,10.32, 
     2.25,5.7,2.78,3.17,9.03,0.95,0.88, 
     7.73,2.75,1.77,1.92,1.83,0.57,1.13) 
event <-c("AF201","SS431","BE201","CD331","HG511","CD331","WQ115", 
     "CD331","SS431","WQ115","HG511","WQ115","CD331","AF201", 
     "SS431","WQ115","HG511","WQ115","CD331","AS335","CD331") 

df<-data.frame(date,start,duration,event) 

library(ggplot2) 
library(scales) 

p <- ggplot(df, aes(as.Date(date),as.POSIXct(start,format='%H:%M:%S'),color=event)) 
p <- p+geom_point(alpha = I(6/10),size=5) 
p + ylab("time (hr)") + xlab("date") + scale_x_date(labels = date_format("%m/%d")) + 
scale_y_datetime(labels = date_format("%H"))+ 
scale_colour_hue(h=c(360, 90)) 
theme(axis.text.x = element_text(hjust=1, angle=0)) 

Результирующий график выглядит следующим образом:

Вопрос: Вместо того, чтобы просто с указанием времени начала события с одной точкой (как показано выше), как я могу построить график, который охватывает продолжительность времени события? Как показано в фрейме данных выше, у меня есть данные продолжительности (в часах). В качестве альтернативы я мог бы предоставить «время остановки» (не показано).

Я представляю, что решение будет выглядеть как сложная гистограмма. Тем не менее, гистограмма не совсем правильная, так как предполагает, что панель начинается в нижней части графика и что события с вертикальной укладкой не имеют промежутков между ними. Мои события могут быть несмежными - «запуск» и «остановка» в разных положениях вдоль оси y. Решение также должно принять во внимание, что 1) некоторые события могут в конечном счете быть параллельными (перекрываться во времени), а 2) некоторые события будут охватывать несколько дней.

Буду очень признателен за любые предложения!

Answer 1

Спасибо (+ 1s) к @Michele и @alexwhan для входа. Используя geom_rect, я смог получить все события, которые происходят в одну и ту же дату в одной точке оси x. (Я ожидаю, что этот набор данных может в конечном счете, включают в себя много месяцев событий.)

df<-data.frame(date,start,duration,event) 

library(ggplot2) 

p <- ggplot(df, aes(xmin=as.Date(date),xmax=as.Date(date)+1, 
        ymin=as.POSIXct(start,format='%H:%M:%S'), 
        ymax=as.POSIXct(start,format='%H:%M:%S')+duration*3600, 
        fill=event)) 
p <- p+geom_rect(alpha = I(8/10)) 
p + ylab("time") + xlab("date") + scale_x_date(labels = date_format("%m/%d")) + 
scale_y_datetime(labels = date_format("%H"))+ 
scale_colour_hue(h=c(360, 90)) 
theme(axis.text.x = element_text(hjust=1, angle=0)) 

... в результате этого:

Это довольно близко к тому, что я стремился. Я думаю, что смогу справиться с потенциальной проблемой надстройки, настроив альфу. В идеале я хотел бы, чтобы ось y включала всего один день (от 00 до 00). Для этого я думаю, мне, вероятно, придется переформатировать данные, чтобы события с продолжительностью, выходящими за полночь, перераспределялись на следующий день. (Не знаете, как это сделать в R.)

Answer 2

попробуйте этот способ. Вероятно, это отличается от того, что вы планировали, но я думаю, что это совершенно ясно способ показать свои данные:

df<-data.frame(date,start,duration,event) 

df <- transform(df, 
       start = as.POSIXct(paste(date, start)), 
       end = as.POSIXct(paste(date, start)) + duration*3600) 

df <- df[c("event", "start", "end")] 

library(reshape2) 

df <- melt(df, id.vars="event") 
df$value <- as.POSIXct(df$value, origin=as.Date("1970-01-01")) 

df <- df[order(df$event, df$value),] 

df$eventID <- rep(seq(1, nrow(df)/2, 1), each=2) 

library(ggplot2) 

ggplot(df) + 
    geom_line(aes(value, event, group=eventID, color=event)) 

Answer 3

Это немного неясно, что именно вы хотите - @ ответ Мишель, казалось, хорошо, я не был» t ясно, если вы хотите использовать geom_rect, потому что это сделает для более толстых линий (если это так, просто измените ширину линии), или если возникла другая причина. Я решил сделать это, используя geom_rect, чтобы включить уклонение. Я построил его со стартовой датой на оси х, а время начала и окончания на y. Я настроил данные несколько иначе, чтобы это сделать. Если вы после этого что-то другое, попробуйте сделать это явно, но, по крайней мере, вот еще один вариант:

df<-data.frame(date,start,duration,event) 

df <- transform(df, 
       start = as.POSIXct(paste(date, start)), 
       end = as.POSIXct(paste(date, start)) + duration*3600) 

df <- df[c("event", "start", "end")] 

df$date <- strptime(df$start, "%Y-%m-%d") 
df$start.new <- format(df$start, format = "%H:%M:%S") 
df$end.new <- format(df$end, format = "%H:%M:%S") 
df$day <- factor(as.POSIXct(df$date)) 
levels(df$day) <- 1:4 
df$day <- as.numeric(as.character(df$day)) 
df$event.int <- df$event 
levels(df$event.int) <- 1:7 
df$event.int <- as.numeric(as.character(df$event.int)) 

p <- ggplot(df, aes(day, start)) + geom_rect(aes(ymin = start, ymax = end, 
              xmin = (day - 0.45) + event.int/10, 
              xmax = (day - 0.35) + event.int/10, 
              fill = event)) + 
    scale_x_discrete(limits = 1:4,breaks = 1:4, labels = sort(unique(date)), 
        name = "Start date") + ylab("Duration") 

Answer 4

Сочетание преимуществ: (i) оси Y, содержащей один ~ 24-часовой период; (ii) события, не совпадающие; (iii) события, помеченные в графе в дополнение к легенде; и (iv) краткий код.

library(dplyr) 
library(lubridate) 

# Re-create data frame 
df <- data_frame(date, start, duration, event) %>% 
    mutate(start_dt = as.POSIXct(paste(date, start), tz = 'UTC'), 
      start_hr = hour(start_dt), 
      end_dt = start_dt + duration * 3600, 
      end_hr = hour(end_dt) + (as.Date(end_dt) - as.Date(start_dt)) * 24) 

# Plot 
df %>% ggplot() + 
    geom_segment(aes(x = event, y = start_hr, xend = event, yend = end_hr, 
        color = event, size = 1)) + 
    facet_wrap(~ date, nrow = 1) + 
    guides(size = 'none') 

Изображение участка: