Search code examples
rplotlyr-plotly

Plotly heatmap with different cell widths


I would like to plot an interactive heatmap, where the column widths are different.

Although I managed to get different cell widths, the widths do not correspond to the values and the ordering is not correct.

The order of the x-axis should remain the same as the segments column in the df data.frame.

If the heatmap doesn't work, I would also be fine with a stacked barchart.

df <- structure(list(
  segments = c(101493L, 101493L, 101493L, 101492L, 101492L, 101492L, 101494L, 101494L, 101494L, 102018L, 102018L, 
               102018L, 102018L, 102018L, 102019L, 102019L, 102019L, 102019L, 102019L), 
  timestamp = structure(c(1579233600, 1579240800, 1579248000, 
                          1579233600, 1579240800, 1579248000, 1579233600, 1579240800, 1579248000, 
                          1579219200, 1579226400, 1579233600, 1579240800, 1579248000, 1579219200, 
                          1579226400, 1579233600, 1579240800, 1579248000), class = c("POSIXct", "POSIXt"), tzone = "Europe/Berlin"), 
  value = c(91.772, 91.923, 96.968, 104.307, 101.435, 105.539, 104.879, 104.197, 103.038, 
            96.403, 90.926, 111.807, 115.931, 111.729, 100.129, 86.903, 108.22, 117.841, 112.293), 
  width = c(5L, 5L, 5L, 2L, 2L, 2L, 3L, 3L, 3L, 10L, 10L, 10L, 10L, 10L, 9L, 9L, 9L, 9L, 9L)), 
  row.names = c(1L, 2L, 3L, 11L, 12L, 13L, 21L, 22L, 23L, 31L, 32L, 33L, 34L, 35L,43L, 44L, 45L, 46L, 47L),
  class = "data.frame")


library(plotly)
plot_ly(data = df) %>% 
  add_trace(type="heatmap",
            x = ~as.character(width),
            y = ~timestamp,
            z = ~value,
            xgap = 0.2, ygap = 0.2) %>% 
  plotly::layout(xaxis = list(rangemode = "nonnegative",
                              tickmode = "array",
                              tickvals=as.character(unique(df$width)),
                              ticktext=as.character(unique(df$segments)),
                              zeroline = FALSE))

result


Solution

  • By giving Plotly a matrix for the z-values it seems to work and the widths are respected.

    df$newx <- rep(cumsum(df[!duplicated(df$segments),]$width), rle(df$segments)$length)
    
    mappdf <- expand.grid(timestamp=unique(df$timestamp), newx=unique(df$newx))
    mappdf <- merge(mappdf, df[,c("timestamp","value","newx")], all.x = T, all.y = F, sort = F)
    mappdf <- mappdf[order(mappdf$newx, mappdf$timestamp),]
    
    zvals <- matrix(data = mappdf$value,
                    nrow = length(unique(df$timestamp)),
                    ncol = length(unique(df$newx)))
    
    plot_ly() %>%
      add_heatmap(y = sort(unique(df$timestamp)),
                  x = c(0,unique(df$newx)),
                  z = zvals) %>%
      plotly::layout(xaxis = list(
        title = "",
        tickvals=unique(df$newx),
        ticktext=paste(unique(df$segments), "-", unique(df$width))
      ))