rplotlylubridate

R Plotly trouble with using datetime values for creating barplot with asymmetric error bars


I am trying to create a bar plot that has with bars that represent median time and error bars that represent q3 and q1. Additionally I would like the values which start with a unit of seconds to be represented in MM:SS format ultimately.

I found some solutions here to recommend using datetime values and then only displaying the minutes & seconds since 1970/01/01 00:00:00 and that seems to work ok. But when I apply this solution, my error bars no longer are visible. I'm thinking error_y does not like working with datetime values. (I have to say I agree with it hahah). Essentially I would like both of the results below to occur simultaneously in one figure.

Figure 3 is another dummy version closer to my original data manipulation and including suggested changes.

library(tidyverse)
library(plotly)
library(lubridate)
library(hms)

df <- data.frame(
  group = c("a", "b", "c"),
  median = c(71,75,70),
  q1 = c(20, 21, 19),
  q3 = c(137, 140, 135)
)

fig1 <- df %>% mutate(
  q1.s = duration(q1, "seconds"),
  med.s = duration(median, "seconds"),
  q3.s = duration(q3, "seconds"),
  low.s = duration(median-q1, "seconds"),
  up.s = duration(q3-median, "seconds")
  ) %>% 
  plot_ly(x = ~group, 
          y = ~med.s, 
          type = 'bar', 
          name = ~group,
          error_y = list(type = 'data', 
                          symmetric= FALSE, 
                          arrayminus = ~low.s, 
                          array = ~up.s, 
                          color = '#000000')) %>% 
  layout(yaxis = list(title = 'Median Time'))
  
fig1


fig2 <- df %>% 
  mutate(q1.s = as.POSIXct(hms(duration(q1, "seconds")), format = "%H:%M:%S"),
         med.s = as.POSIXct(hms(duration(median, "seconds")), format = "%H:%M:%S"),
         q3.s = as.POSIXct(hms(duration(q3, "seconds")), format = "%H:%M:%S"),
         low.s = as.POSIXct(hms(duration(median-q1, "seconds")), format = "%H:%M:%S"),
         up.s = as.POSIXct(hms(duration(q3-median, "seconds")), format = "%H:%M:%S")) %>% 
  plot_ly(x = ~group, 
          y = ~med.s, 
          type = 'bar', 
          name = ~group,
          error_y = ~list(type = 'data', 
                          symmetric= FALSE, 
                          arrayminus = ~low.s, 
                          array = ~up.s, 
                          color = '#000000')) %>% 
  layout(yaxis = list(title = 'Median Time', 
                      type = 'date',
                      tickformat="%M:%S",
                      range = c('1970-01-01 00:00:00','1970-01-01 00:02:30'))) 
  
fig2

df2 <- data.frame(
  group = rep(c("a", "b", "c"), times=5),
  t = c(0,0,0,20,21,19,71,75,70,137,140,135,240,240,240)
)

fig3 <- df2 %>% 
  group_by(group) %>%
  mutate(t.s = as.POSIXct(hms::hms(duration(t)), format = "%H:%M:%S")) %>% 
  dplyr::summarise(answer.quantile = list(quantile(t.s,
                                                   probs = seq(.25, .75, by = .25),
                                                   na.rm = TRUE))) %>%
  unnest_wider(answer.quantile) %>% 
  dplyr::rename(q1="25%", med="50%", q3="75%") %>%
  mutate(low = med-q1,
         up = q3-med) %>% 
  plot_ly(x = ~group, 
          y = ~med, 
          type = 'bar', 
          name = ~group,
          error_y = list( 
                          symmetric= FALSE, 
                          arrayminus = ~low, 
                          array = ~up, 
                          color = '#000000')) %>% 
  layout(yaxis = list(title = 'Median Time',
                      type = 'date',
                      tickformat="%M:%S",
                      range = c('1970-01-01 00:00:00','1970-01-01 00:02:30')),
         xaxis = list(title = ' ', categoryorder='trace')) 

fig3

Solution

  • When I left my comment about using hms::hms() I was only addressing part of the problem: the axes labels. Sorry about that.

    Here's a solution to both the axis labels and the error bars. This is a workaround because Plotly doesn't support error bars on a date-type axis.

    You can read about error bars and their lack of date-type support here.

    Starting with the libraries, this uses htmlwidgets (htmlwidgets::onRender) in addition to the libraries you were already using.

    The data:

    You can go back to df, your original data, because if you format this for dates, you can't keep the error bars--- or you have to add them as shapes.

    library(tidyverse)
    library(plotly)
    library(htmlwidgets)
    
    df <- data.frame(
      group = c("a", "b", "c"),
      median = c(71,75,70),
      q1 = c(20, 21, 19),
      q3 = c(137, 140, 135)
    )
    

    We're going to create a customdata object for the hover content representing the y-axis using a UDF.

    Here's that number-modifying function.

    nfm <- function(val) {   # format the numbers in m:ss format
      lapply(val, \(x) {     # for each in val
        m = floor(x/60)      # id minutes
        s = x %% 60          # id seconds
        ifelse(s == 0, paste0(m, ":00"), 
               paste0(m, ":", formatC(s, width = 2, flag = 0)))
      }) %>% unlist()        # return a vector of strings m:ss
    }
    

    The plot:

    Finally, call the plot and onRender. In the plot, since we're using df, you'll see median instead of med, the addition of customdata and hovertemplate. You'll also see that arrayminus, and array are different as well.

    In layout, you'll see that yaxis only calls for a title modification now.

    In onRender, you'll see trfm, this does the same thing as nfm did to create customdata, only this is in Javascript. frmtMe calls the html elements that are associated with the y ticks. If the labels don't contain a ":" then they modify the content using trfm. Next, frmtMe is called for the initial plot. The last element of onRender is el.on, which triggers frmtMe if the plot is resized, zoomed, etc. --anything that may cause the y-axis to change.

    df %>%              # using df instead of the date-formatted data
        plot_ly(x = ~group, y = ~median, type = 'bar', name = ~group,
                customdata = nfm(df$median),          # added customdata for tooltips
                hovertemplate = "%{x} %{customdata}", # using the customdata
                error_y = list( symmetric= FALSE, arrayminus = ~q1, 
                                array = ~(q3 - median), color = '#000000')
                ) %>% 
        layout(yaxis = list(title = 'Median Time'),
               xaxis = list(title = '', categoryorder='trace')) %>% 
        htmlwidgets::onRender(
          'function(el, x) {
          trfm = function(d){            /* reformat value */
            var mn = Math.floor(d/60);   /* divide the value by 60, rounding down */
            var sc = (d % 60);           /* find the modulo (remainder) when div by 60 */
            return (sc == 60 ? (mn+1) + ":00" : mn + ":" + (sc < 10 ? "0" : "") + sc)
          }                              /* return m:ss reformatted string */
          
          frmtMe = function() {          /* is formatting needed? */
            var here = document.querySelectorAll("g.ytick");    /* find the labels */
            here.forEach(function(it, ind) {                    /* call trfm() to reformat */
              if(!/:/.test(here[ind].firstChild.textContent)) { /* formatted if necessary */
                  here[ind].firstChild.textContent = trfm(here[ind].firstChild.textContent)
              }
            });
          }
          frmtMe();                          /* format the intial plot */
          el.on("plotly_relayout", frmtMe);  /* reformat if necessary */
        }')
    

    enter image description here

    Let me know if anything is unclear or if you have questions.

    Here's all the code above all in one place. (Easier copy + paste)

    library(tidyverse)
    library(plotly)
    
    df <- data.frame(
      group = c("a", "b", "c"),
      median = c(71,75,70),
      q1 = c(20, 21, 19),
      q3 = c(137, 140, 135)
    )
    
    nfm <- function(val) {   # format the numbers in m:ss format
      lapply(val, \(x) {     # for each in val
        m = floor(x/60)      # id minutes
        s = x %% 60          # id seconds
        ifelse(s == 0, paste0(m, ":00"), 
               paste0(m, ":", formatC(s, width = 2, flag = 0)))
      }) %>% unlist()        # return a vector of strings m:ss
    }
    
    df %>%              # using df instead of the date-formatted data
        plot_ly(x = ~group, y = ~median, type = 'bar', name = ~group,
                customdata = nfm(df$median),          # added customdata for tooltips
                hovertemplate = "%{x} %{customdata}", # using the customdata
                error_y = list( symmetric= FALSE, arrayminus = ~q1, 
                                array = ~(q3 - median), color = '#000000')
                ) %>% 
        layout(yaxis = list(title = 'Median Time'),
               xaxis = list(title = '', categoryorder='trace')) %>% 
        htmlwidgets::onRender(
          'function(el, x) {
          trfm = function(d){            /* reformat value */
            var mn = Math.floor(d/60);   /* divide the value by 60, rounding down */
            var sc = (d % 60);           /* find the modulo (remainder) when div by 60 */
            return (sc == 60 ? (mn+1) + ":00" : mn + ":" + (sc < 10 ? "0" : "") + sc)
          }                              /* return m:ss reformatted string */
          
          frmtMe = function() {          /* is formatting needed? */
            var here = document.querySelectorAll("g.ytick");    /* find the labels */
            here.forEach(function(it, ind) {                    /* call trfm() to reformat */
              if(!/:/.test(here[ind].firstChild.textContent)) { /* formatted if necessary */
                  here[ind].firstChild.textContent = trfm(here[ind].firstChild.textContent)
              }
            });
          }
          frmtMe();                          /* format the intial plot */
          el.on("plotly_relayout", frmtMe);  /* reformat if necessary */
        }')