5

I am trying to connect the stacked bars with lines.

Expectation :

enter image description here

However I am unable to draw the lines between the bars. Have tried with the following script however it is not adding the line.

Using add_trace instead of 'add_lines' is not working.

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 )

Getting output like this :

enter image description here

ismirsehregal
  • 30,045
  • 5
  • 31
  • 78
Soumya Boral
  • 1,191
  • 14
  • 28

1 Answers1

7

Sorry, I dropped a few lines of your example, as it isn't really minimal. Furthermore, I switched from dplyr to data.table as I'm more familar with it and melting the table makes thing much easier.

However, I hope the following is still helpful to you:

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

Result

ismirsehregal
  • 30,045
  • 5
  • 31
  • 78
  • I've been workiing with what turned out to be a sub-optimal solution for quite some time now. I just wanted to say that this approach is pretty impressive in all its simple beauty. – vestland Nov 19 '19 at 10:37
  • 1
    Thanks! What I'm not really happy with is the trace deselection on the legend (the lines might get misaligned when deselecting some of the traces, since the bar stacking works dynamically). Might be better to hide the legend. – ismirsehregal Nov 19 '19 at 11:40
  • 2
    Try adding `legend = list(itemclick = FALSE, itemdoubleclick = FALSE)` to your layout definition. This will allow the legend to remain but eliminate the issue with dynamic stacking by preventing the bars from being hidden/shown with by interacting with the legend. [See Plotly R Reference: layout-legend-itemclick](https://plot.ly/r/reference/#layout-legend-itemclick) – Matt Summersgill Nov 19 '19 at 15:18
  • 1
    @MattSummersgill thanks for the hint! Added `legend = list(itemclick = FALSE, itemdoubleclick = FALSE)` to the layout. – ismirsehregal Nov 19 '19 at 15:26
  • Moreover, added `hoverinfo="none"` for the lines, as they were misleading. – ismirsehregal Nov 19 '19 at 15:44
  • This is almost complete. Can you please add the sum and within cell numbers please ? – Soumya Boral Nov 19 '19 at 17:28
  • @SoumyaBoral added the annotations - please check my edit. – ismirsehregal Nov 19 '19 at 18:31