R 使用日期时间值创建具有不对称误差线的条形图时出现问题

问题描述 投票：0回答：1

我正在尝试创建一个条形图，其中包含代表中值时间的条形图和代表 q3 和 q1 的误差条形图。另外，我希望最终以 MM:SS 格式表示以秒为单位的值。

我在这里找到了一些解决方案，建议使用日期时间值，然后只显示自 1970/01/01 00:00:00 以来的分钟和秒，这似乎工作正常。但是当我应用这个解决方案时，我的错误栏不再可见。我认为 error_y 不喜欢使用日期时间值。 （我不得不说我同意哈哈）。 本质上，我希望下面的两个结果同时出现在一张图中。

图 3 是另一个虚拟版本，更接近我的原始数据操作，并包括建议的更改。

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
r plotly lubridate
1个回答
0
投票

当我留下关于使用 

hms::hms()
的评论时，我只是解决了部分问题：轴标签。对此感到抱歉。

这是轴标签和误差线的解决方案。这是一种解决方法，因为 Plotly 不支持日期类型轴上的误差线。

您可以在此处阅读有关错误栏及其缺乏日期类型支持的信息。

从库开始，除了您已经使用的库之外，还使用 

htmlwidgets
(
htmlwidgets::onRender
)。

数据：

您可以返回到

df
，您的原始数据，因为如果您将其格式化为日期，则无法保留误差线——或者您必须将它们添加为形状。

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

我们将使用 UDF 为表示 y 轴的悬停内容创建一个 

customdata
对象。

这是数字修改功能。

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
}

剧情：

最后，调用情节并

onRender
。在图中，由于我们使用的是 
df
，因此您会看到 
median
而不是 
med
，添加了 
customdata
和 
hovertemplate
。您还会发现 
arrayminus
和 
array
也不同。

在

layout
中，您会看到
yaxis
现在只要求修改标题。

在 

onRender
中，你会看到 
trfm
，这与 
nfm
创建 
customdata
的作用相同，只是这是在 Javascript 中。 
frmtMe
调用与 y 刻度相关的 html 元素。如果标签不包含“：”，则它们使用 
trfm
修改内容。接下来，为初始绘图调用 
frmtMe
。 
onRender
的最后一个元素是 
el.on
，如果调整绘图大小、缩放等任何可能导致 y 轴发生变化的操作，都会触发 
frmtMe
。

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 */
    }')

如果有任何不清楚或有疑问，请告诉我。

以上所有代码都集中在一处。 （更容易复制+粘贴）

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 */
    }')
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.