用R中的线条连接条形图

Posted 2023-02-14

【中文标题】用R中的线条连接条形图

【英文标题】：Connect bars with lines in R plotly

【发布时间】：2020-03-08 14:13:09

【问题描述】：

我正在尝试用线条连接堆叠的条形图。

期待：

但是我无法在条之间画线。已尝试使用以下脚本，但它没有添加该行。

使用 add_trace 代替 'add_lines' 不起作用。

df = data.frame(Aria = 20:25, Acqua = 21:26, Fuoco = 22:27, 
                Terra = 23:28, Cielo = 24:29, 
                Labels = c( 'Antonio', 'Maria', 'Giovanni',
                            'Sergio', 'Giorgio', 'Michele' ) )

evo_bar_plot_variant = function(plot_data, var_x, x_name = 'X axis', 
                                y_name = 'Y axis', ... )
  df = data.frame(plot_data) 
  df = na.omit(df)
  var = quos(...) 
  names_vars = names( var )
  y_vars = names_vars[ startsWith( names_vars, 'var_y' ) ]
  y_var_names = sapply(1:length(y_vars), function(j) 
                          quo_name(var[[y_vars[j]]] ))
  row_sum = df %>% 
              select( y_var_names ) %>% 
              rowSums()
  xenc = enquo( var_x )
  cols = colorRampPalette(c("white", "#4C68A2"))( length( y_vars ) )

  #... Plot parameters .....
  font_size = list( size = 12, family = 'Lato' )
  gray_axis = '#dadada'
  p = plot_ly(data = df, x = xenc, y = var[[ y_vars[1] ]], 
              name = quo_name( var[[ y_vars[1] ]] ), 
              type = 'bar', marker = list( color = cols[1], 
              line = list( color = '#E1E1E1', width = 0.8 ) ), 
              hoverlabel = list( font = font_size ) ) %>%
    layout(title = list( text = 'Bar', x = 0 ), barmode = 'stack',
           yaxis = list( title = y_name, showgrid = F, 
           zerolinecolor = gray_axis,
           titlefont = font_size, side = 'right' ),
           xaxis = list(title = x_name, linecolor = gray_axis,
                        zerolinecolor = gray_axis,
                        tickfont = font_size, titlefont = font_size),
           legend = list(font = font_size, orientation= 'h', 
                         font = font_size, x = 1 , y = 1.2, 
                         xanchor = "left", yanchor = 'top' ))

  if( length( y_vars ) >= 2 )
    for( i in 2:length( y_vars ) )
      p = p %>% 
            add_trace(y = var[[ y_vars[i] ]], 
                      name = quo_name( var[[ y_vars[i] ]] ), 
                      marker = list(color = cols[i], 
                      line = list(color = '#E1E1E1', width = 0.8)), 
                      hoverlabel = list(font = font_size))
    
  

  p =  p %>% 
        add_annotations(xref = 'x', yref = 'y', 
                        y = ( row_sum ) + 5, x = xenc,
                        text = paste( row_sum ), 
                        font = font_size, showarrow = F )

  p      


evo_bar_plot_variant( df, var_x = Labels, var_y1 = Aria, var_y2 = Acqua, var_y3 = Fuoco, var_y4 = Terra,
              var_y5 = Cielo )

得到这样的输出：

【参考方案1】：

抱歉，我删除了您的示例中的几行代码，因为它确实不是最小的。此外，我从dplyr 切换到data.table，因为我对它更熟悉，并且融化桌子让事情变得更容易。

但是，我希望以下内容仍然对您有所帮助：

library(plotly)
library(data.table)

DF = data.frame(
  Aria = 20:25,
  Acqua = 21:26,
  Fuoco = 22:27,
  Terra = 23:28,
  Cielo = 24:29,
  Labels = c('Antonio', 'Maria', 'Giovanni',
             'Sergio', 'Giorgio', 'Michele')
)

setDT(DF)

DT <- melt.data.table(DF, id.vars = "Labels")
DT[, c("label_group", "cumsum_by_label") := .(.GRP, cumsum(value)), by = Labels]

lineDT <- rbindlist(list(DT[, .(
  label_group = label_group - 0.4,
  cumsum_by_label = cumsum_by_label,
  variable = variable
)],
DT[, .(
  label_group = label_group + 0.4,
  cumsum_by_label = cumsum_by_label,
  variable = variable
)]))

p <- plot_ly(
  DT,
  x = ~ label_group,
  y = ~ value,
  color = ~ variable,
  type = "bar",
  colors = ~ colorRampPalette(c("white", "#4C68A2"))(length(unique(variable)) + 1)[-1],
  legendgroup =  ~ variable,
  showlegend = TRUE
) %>%
  layout(
    title = list(text = 'Bar', x = 0),
    barmode = 'stack',
    legend = list(itemclick = FALSE, itemdoubleclick = FALSE)
  ) %>%
  layout(
    xaxis = list(
      title = "X axis",
      ticktext = ~ Labels,
      tickvals = ~ label_group,
      tickmode = "array"
    ),
    yaxis = list(title = "")
  ) %>%
  add_annotations(
    text = ~ value,
    xref = 'x',
    yref = 'y',
    y = ~ cumsum_by_label - value / 2,
    x = ~ label_group,
    showarrow = FALSE
  ) %>%
  add_annotations(
    data = DT[, .(maxval = max(cumsum_by_label),
                  label_group = unique(label_group)), by = Labels],
    inherit = FALSE,
    text = ~ maxval,
    xref = 'x',
    yref = 'y',
    y = ~ maxval,
    x = ~ label_group,
    showarrow = FALSE,
    yshift = 20
  ) %>%
  add_lines(
    data = lineDT,
    inherit = FALSE,
    x = ~ c(label_group),
    y = ~ cumsum_by_label,
    color = ~ variable,
    legendgroup =  ~ variable,
    showlegend = FALSE,
    hoverinfo = "none"
  )

p

【讨论】：

我一直在研究一个被证明是次优的解决方案已经有一段时间了。我只想说，这种方法在所有简单的美中都令人印象深刻。

谢谢！我不太满意的是图例上的迹线取消选择（取消选择某些迹线时线条可能会错位，因为条形堆叠是动态工作的）。隐藏图例可能会更好。

尝试将legend = list(itemclick = FALSE, itemdoubleclick = FALSE) 添加到您的布局定义中。这将允许图例保留，但通过与图例交互防止条被隐藏/显示来消除动态堆叠的问题。 See Plotly R Reference: layout-legend-itemclick

@MattSummersgill 感谢您的提示！在布局中添加了legend = list(itemclick = FALSE, itemdoubleclick = FALSE)。

此外，为这些行添加了hoverinfo="none"，因为它们具有误导性。