0

I would like to create a widget in rshiny displaying the duration of events using plotly.
I have a df with 4 events and their starting and ending time.

event = c("event_1","event_2","event_3","event_4","event_4","event_2","event_3","event_4","event_4","event_2","event_3","event_4","event_1","event_2","event_3","event_4")
start <- as.POSIXct(c("2019-05-02 07:08:49", "2019-05-02 07:09:21",
                     "2019-05-02 07:09:41", "2019-05-02 07:10:05",
                     "2019-05-02 07:24:52", "2019-05-02 07:28:50",
                     "2019-05-02 07:29:23", "2019-05-02 07:30:16",
                     "2019-05-02 07:33:13", "2019-05-02 07:33:43",
                     "2019-05-02 07:35:31", "2019-05-02 07:36:29",
                     "2019-05-02 07:38:14", "2019-05-02 07:43:26",
                     "2019-05-02 07:44:59", "2019-05-02 07:53:45"))
stop <- as.POSIXct(c("2019-05-02 07:09:29", "2019-05-02 07:10:02",
                   "2019-05-02 07:10:17", "2019-05-02 07:10:40",
                   "2019-05-02 07:29:10", "2019-05-02 07:29:32",
                   "2019-05-02 07:30:35", "2019-05-02 07:30:53",
                   "2019-05-02 07:33:48", "2019-05-02 07:34:18",
                   "2019-05-02 07:36:06", "2019-05-02 07:38:34",
                   "2019-05-02 07:38:49", "2019-05-02 07:45:19",
                   "2019-05-02 07:45:35", "2019-05-02 07:54:20"))

df <- data.frame(event = event, start = start, stop = stop)
df

I followed the gantt chart tutorial from here: https://plot.ly/r/gantt/

cols <- RColorBrewer::brewer.pal(length(unique(df$event)), name = "Set3")
df$color <- factor(df$event, labels = cols)

library(plotly)
p <- plot_ly()

for(i in 1:(nrow(df))){
  p <- add_trace(p,
                 x = c(df$start[i], df$stop[i]),  # x0, x1
                 y = c(i, i),  # y0, y1
                 mode = "lines",
                 line = list(color = df$color[i], width = 20),
                 hoverinfo = "text",
                 evaluate = T  # needed to avoid lazy loading
  )
}

p %>% layout(legend = list(orientation = "h",   
                           xanchor = "center", 
                           x = 0.5))

which gave me this plot1: enter image description here
but this is not quite what I am after.

What I am after looks like this plot2:

I was able to achieve this using ggplot2 and ggplotly() but I can't get the x-axes to show minutes after zooming-in. The x-axes is far from detailed.

library(ggplot2)
gp <- ggplot(df, aes(colour = event)) + 
  geom_segment(aes(x = start, xend = stop , y = event, yend = event), size = 6) +
  theme_bw() 

ggplotly(gp)

I have two questions, and I should probably divide them into two separate posts although they are workarounds of themselves.

the plotly way: How can I have x-axes holding 4 events and y-axes with their corresponding duration? (like in plot2)

the ggplotly() way: How can I have more detailed y-axes that displays minutes after zooming in? (like in plot1 - although it is not visible from the .png - the minutes are there)

Thank you in advance!

UPDATE
scale_x_datetime(), date_format() gave a detailed xaxis. But now it needs auto hide option.

library(ggplot2)
gp <- ggplot(df, aes(colour = event)) + 
  geom_segment(aes(x = start, xend = stop , y = event, yend = event), size = 6) +
  theme_bw() +
  scale_x_datetime(breaks = ("1 min"), labels = scales::date_format("%H:%M"))

ggplotly(gp)

enter image description here

eyei
  • 402
  • 4
  • 12

1 Answers1

1

I could only figure out the plotly way.

I think the ggplotly()function fixes some configurations of plotly. I tried looking at layout configurations to make it change the format when you zoom, but I could not find it.

So I will just leave my answer for the plotly case.

plotly way

You were almost there. First, notice that each time you call add_trace, it creates a new trace in your legend. Since you were looping over rows, you create a new trace for every row.

Also, inside add_trace, you set y = c(i, i). This explains why events are not aligned.

This is how I did it.

First, I used add_segments. This way I could give x, y, xend, yend explicitly (I can also give the vectors with all intervals for each event). Second, instead of looping over rows, I looped over the events. Then, I filtered the rows for each event and called add_segments once for each event. I also set y = df2$event and yend=df2$event (which are factors with levels [1, 2, 3, 4]).

p <- plot_ly()

for(e in unique(df$event)){
  df2 <- df %>% filter(event == e)

  p <- add_segments(p,
                    x = df2$start,
                    y = df2$event,
                    xend=df2$stop,
                    yend=df2$event,
                    line = list(color = df2$color, width = 20),
                    hoverinfo = "text",
                    name=as.character(e)
                    )
}

p %>% layout(legend = list(orientation = "h",   
                           xanchor = "center", 
                           x = 0.5))

enter image description here

kikoralston
  • 1,176
  • 5
  • 6
  • Thank you, kikoralston, for the solution and the explanations! I will stick to the plotly way. In respect to ggplotly way, I managed to add minutes on x-axis but it is a bit crowded. Now it needs an "auto-hide" option of some kind, which I can't find yet. I will update my post. -All the best! – eyei Aug 28 '19 at 20:06