R plotly：分隔（带有空白）x轴标签数据

Question

我有几个数据聚合（年、季度、月）的数据。 我尝试在 x 轴标签中的每个日期聚合之间留一个空格。

我暂时得到了这个：

我想获得：

这是我的数据：

我的数据框（dput）：

r8_plot = structure(list(DATE = c(2016L, 2017L, 2018L, 201701L, 201702L, 
201703L, 201704L, 201801L, 201802L, 201803L, 201804L, 201801L, 
201802L, 201803L, 201804L, 201805L, 201806L, 201807L, 201808L, 
201809L, 201810L, 201811L, 201812L, 201844L, 201845L, 201846L, 
201847L, 201848L, 201849L, 201850L), Var1 = c(6.64, 6.21, 6.53, 
6.31, 6.01, 6.36, 6.17, 6.76, 6.37, 6.68, 6.27, 7.5, 6.49, 6.4, 
6.54, 6.18, 6.37, 5.98, 6.37, 7.48, 6.6, 5.97, 6.25, 5.42, 6.18, 
5.81, 6.46, 6.36, 6.05, 6.35), Var2 = c(2.38, 2.25, 2.36, 2.22, 
2.52, 1.98, 2.27, 2.44, 2.31, 2.27, 2.41, 2.53, 2.25, 2.51, 2.35, 
2.42, 2.19, 2.51, 1.91, 2.38, 2.34, 2.29, 2.68, 2.15, 1.89, 2.6, 
2.52, 2.37, 2.97, 2.71), Var3 = c(4.26, 3.96, 4.17, 4.09, 3.5, 
4.38, 3.9, 4.32, 4.06, 4.4, 3.86, 4.96, 4.23, 3.9, 4.19, 3.77, 
4.18, 3.47, 4.46, 5.1, 4.26, 3.68, 3.57, 3.27, 4.29, 3.2, 3.95, 
3.99, 3.09, 3.64), Var4 = c(35.84, 36.17, 36.08, 35.2, 41.86, 
31.17, 36.76, 36.07, 36.27, 34.07, 38.43, 33.78, 34.76, 39.18, 
35.95, 39.07, 34.35, 42.04, 29.91, 31.8, 35.48, 38.38, 42.86, 
39.72, 30.53, 44.85, 38.94, 37.24, 48.98, 42.63), Var5 = c("Y", 
"Y", "Y", "Q", "Q", "Q", "Q", "Q", "Q", "Q", "Q", "M", "M", "M", 
"M", "M", "M", "M", "M", "M", "M", "M", "M", "W", "W", "W", "W", 
"W", "W", "W"), Var6 = structure(1:30, .Label = c("2016", "2017", 
"2018", "Q1-2017", "Q2-2017", "Q3-2017", "Q4-2017", "Q1-2018", 
"Q2-2018", "Q3-2018", "Q4-2018", "M01-2018", "M02-2018", "M03-2018", 
"M04-2018", "M05-2018", "M06-2018", "M07-2018", "M08-2018", "M09-2018", 
"M10-2018", "M11-2018", "M12-2018", "W44-2018", "W45-2018", "W46-2018", 
"W47-2018", "W48-2018", "W49-2018", "W50-2018"), class = "factor"), 
    Var7 = c(7.1, 6.7, 6.7, 6.7, 6.7, 6.6, 6.6, 6.7, 6.7, 6.6, 
    6.6, 6.7, 6.7, 6.7, 6.7, 6.7, 6.6, 6.6, 6.6, 6.6, 6.6, 6.6, 
    6.6, 6.6, 6.6, 6.6, 6.6, 6.6, 6.6, 6.6)), .Names = c("DATE", 
"Var1", "Var2", "Var3", "Var4", "Var5", "Var6", "Var7"), row.names = c(NA, 
30L), class = "data.frame")



r8_plot$Var6 = factor(r8_plot$Var6, labels = unique(r8_plot$Var6), levels=unique(r8_plot$Var6))

library(plotly)

r8_plot %>% plot_ly(x = ~Var6) %>% 
add_bars(y = ~Var1,marker = list(color = '#00802b'),
       name = "Var1") %>% 
add_bars(y = ~Var2,marker = list(color = '#ff9933'),
       name = "Var2")%>%
add_lines(y = ~Var4,
        name = "Var4",
        yaxis = "y2", line = list(color = '#1a1aff'))%>%
add_lines(y = ~Var7,
        name = "Var7",
        yaxis = "y1")%>%
layout(barmode = "stack",
     yaxis2 = list(overlaying = "y",side = "right"),barmode = "stack",xaxis = list(title = 'DATE'), yaxis = list(title = 'All quantity'), title ="Chart") %>% layout(height = 750, width = 1000, hovermode = 'closest',margin = list(b = 115))

提前致谢

Answer 1

您可以将NaN y 值添加到任何数据框中，Plotly 将在此位置中断绘图。

例如

library(plotly)

data = data.frame(list(x = c(1, 2, NaN, 3, 4), 
                       y = c(1, 2, NaN, 3, 4)))

plot_ly(data, x = ~x) %>% 
  add_lines(y = ~y)

会给你

对于更复杂的数据，如问题中，引入空行的函数可能比手动执行更容易。

split_by_date <- function(data) {
  data_length <- length(data[,1])
  index <- 0  
  new_data <- data
  new_line <- list(replicate(length(data), NaN))

  for (i in 2:length(data$DATE)) {
    if (substr(toString(data$Var6[[i]]), 1, 1) != substr(toString(data$Var6[[i - 1]]), 1, 1)) {
      new_data <- rbind.data.frame(new_data[1:i + index - 1,], new_line[[1]], data[i:data_length,])
      new_data$Var6[[index + i]] <- paste(replicate(index + 1, " "), collapse = " ")
      index <- index + 1
      rownames(new_data) <- 1:as.integer(data_length + index)
    }
  }
  return(new_data)
}

我们只需要确保 x 值始终是唯一的，即简单地连接越来越多的空格。 否则，我们只会在图表中出现一个中断。

还引入了另一行x以帮助以正确的顺序绘制 x 值。

r8_plot = structure(list(DATE = c(2016L, 2017L, 2018L, 201701L, 201702L, 201703L, 201704L, 201801L, 201802L, 201803L, 201804L, 201801L, 201802L, 201803L, 201804L, 201805L, 201806L, 201807L, 201808L, 201809L, 201810L, 201811L, 201812L, 201844L, 201845L, 201846L, 201847L, 201848L, 201849L, 201850L), 
                         Var1 = c(6.64, 6.21, 6.53, 6.31, 6.01, 6.36, 6.17, 6.76, 6.37, 6.68, 6.27, 7.5, 6.49, 6.4, 6.54, 6.18, 6.37, 5.98, 6.37, 7.48, 6.6, 5.97, 6.25, 5.42, 6.18, 5.81, 6.46, 6.36, 6.05, 6.35), 
                         Var2 = c(2.38, 2.25, 2.36, 2.22, 2.52, 1.98, 2.27, 2.44, 2.31, 2.27, 2.41, 2.53, 2.25, 2.51, 2.35, 2.42, 2.19, 2.51, 1.91, 2.38, 2.34, 2.29, 2.68, 2.15, 1.89, 2.6, 2.52, 2.37, 2.97, 2.71),                          
                         Var3 = c(4.26, 3.96, 4.17, 4.09, 3.5, 4.38, 3.9, 4.32, 4.06, 4.4, 3.86, 4.96, 4.23, 3.9, 4.19, 3.77, 4.18, 3.47, 4.46, 5.1, 4.26, 3.68, 3.57, 3.27, 4.29, 3.2, 3.95, 3.99, 3.09, 3.64), 
                         Var4 = c(35.84, 36.17, 36.08, 35.2, 41.86, 31.17, 36.76, 36.07, 36.27, 34.07, 38.43, 33.78, 34.76, 39.18, 35.95, 39.07, 34.35, 42.04, 29.91, 31.8, 35.48, 38.38, 42.86, 39.72, 30.53, 44.85, 38.94, 37.24, 48.98, 42.63), 
                         Var5 = c("Y", "Y", "Y", "Q", "Q", "Q", "Q", "Q", "Q", "Q", "Q", "M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "W", "W", "W", "W", "W", "W", "W"), 
                         Var6 = c("2016", "2017", "2018", "Q1-2017", "Q2-2017", "Q3-2017", "Q4-2017", "Q1-2018", "Q2-2018", "Q3-2018", "Q4-2018", "M01-2018", "M02-2018", "M03-2018","M04-2018", "M05-2018", "M06-2018", "M07-2018", "M08-2018", "M09-2018", "M10-2018", "M11-2018", "M12-2018", "W44-2018", "W45-2018", "W46-2018", "W47-2018", "W48-2018", "W49-2018", "W50-2018"), 
                         Var7 = c(7.1, 6.7, 6.7, 6.7, 6.7, 6.6, 6.6, 6.7, 6.7, 6.6, 6.6, 6.7, 6.7, 6.7, 6.7, 6.7, 6.6, 6.6, 6.6, 6.6, 6.6, 6.6,6.6, 6.6, 6.6, 6.6, 6.6, 6.6, 6.6, 6.6)), 
                    .Names = c("DATE", "Var1", "Var2", "Var3", "Var4", "Var5", "Var6", "Var7"), row.names = c(NA, 30L), class = "data.frame")


plot <- split_by_date(r8_plot)

plot$x <- structure(1:length(plot$Var6), .Label = plot$Var6, class = "factor")
plot %>% plot_ly(x = ~x, height = 750, width = 1000) %>% 
  add_bars(y = ~Var1,
           marker = list(color = '#00802b'),
           name = "Var1") %>% 
  add_bars(y = ~Var2,
           marker = list(color = '#ff9933'),
           name = "Var2") %>%
  add_lines(y = ~Var4,
            name = "Var4",
            yaxis = "y2", 
            line = list(color = '#1a1aff')) %>%
  add_lines(y = ~Var7,
            name = "Var7",
            yaxis = "y1") %>%
  layout(barmode = "stack",
         xaxis = list(title = 'DATE', range = c(-0.1, 10)), 
         yaxis = list(title = 'All quantity'), 
         yaxis2 = list(overlaying = "y",
                       side = "right"),
         title ="Chart", 
         hovermode = 'closest')