绘制具有不同单元格宽度的热图

Plotly heatmap with different cell widths

我想绘制一个交互式热图,其中列宽不同。

虽然我设法获得了不同的单元格宽度,但宽度与值不对应且顺序不正确

x 轴的顺序应与 df data.frame 中的 segments 列相同。

如果热图不起作用,我也可以使用堆叠条形图。

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))

通过给 Plotly 一个 z-values 的矩阵,它似乎可以工作并且宽度得到尊重。

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))
  ))