Is it possible to use plot_hd_links to visualize differences of more than 2 groups within one plot?

[greggyfromtheblock]

Hey im looking to visualize differences between 5 groups in my plot, I noticed that the shifthd function does return the shift outputs for more than 2 groups. So the idea is to compare group1 -> group2 and then group2 -> group3, group3 -> group4 and so on. Would be amazing if theres an easy way to do that with the current implementation :)

[greggyfromtheblock]

Nvm I solved it :) I'll post the code here if someone will need it

Here is the modified function with the extra argument position

plot_hd_linksx <- function(p,
                          sf = sf,
                          position=1,
                          q_col = "grey21",
                          q_width = 0.5,
                          q_size = 0.5,
                          md_size = 1,
                          link_col = c("darkviolet","darkorange2"),
                          link_alpha = c(0.4, 1),
                          add_rect = FALSE,
                          rect_alpha = NULL,
                          rect_col = NULL,
                          add_lab = FALSE,
                          labres = 2,
                          text_size = 5){
  

  g1 <- sf[[2]]
  g2 <- sf[[3]]
  diff <- sf[[4]]


  diff_sign <- (sign(diff) > 0) + 1
  q_seq <- sf[[1]]
  qn <- length(q_seq)
  deco <- c(seq(1, floor(qn/2) + 1), seq(floor(qn/2), 1))
  alpha_seq <- seq(link_alpha[1], link_alpha[2], length.out = floor(qn/2) + 
                     1)
  line_size <- c(rep(q_size, floor(qn/2)), md_size, rep(q_size, 
                                                        floor(qn/2)))


  for (d in 1:qn) {
    # plot quantiles: group / condition 1
    p <- p + annotate("segment", x = position - q_width/2, xend = position + 
                        q_width/2, y = g1[d], yend = g1[d], colour = q_col, size = line_size[d])
    # plot quantiles: group / condition 2
    p <- p + annotate("segment", x = position + 1 - q_width/2, xend = position + 1 + 
                        q_width/2, y = g2[d], yend = g2[d], colour = q_col, size = line_size[d])
    # link quantiles between groups / conditions
    p <- p + annotate("segment", x = position + q_width/2, xend = position+1 - 
                        q_width/2, y = g1[d], yend = g2[d], colour = link_col[diff_sign[d]], 
                      alpha = alpha_seq[deco[d]], size = line_size[d])
  }
  # add rectangle
  if (add_rect == TRUE) {
    if (is.null(rect_alpha)) {
      rect_alpha <- 0.2
    }
    if (is.null(rect_col)) {
      rect_col <- "grey30"
    }
    p <- p + annotate("rect", xmin = position-0.6, xmax = position+ 0.25, ymin = g1[1], 
                      ymax = g1[qn], alpha = rect_alpha)
  }

  if (add_lab == TRUE) {
    for (d in seq(1, qn, qn - 1)) {
      p <- p + annotate("label", x = position+ 0.5, y = min(g1[d], g2[d]) + abs(g1[d] - g2[d])/2, label = round(diff[d], labres), fill = link_col[diff_sign[d]], colour = "white", fontface = "bold", alpha = alpha_seq[deco[d]])
    } # for loop
  } # if add_lab
  p
}

And here's an example on how you use it

set.seed(21) # generate data
n <- 5000 # sample size
df <- tibble(gr = factor(c(rep("group1",n),
                           rep("group2",n),
                           rep("group3",n),
                           rep("group4",n))),
             obs= c(rnorm(n)+6, 
                    rnorm(n)+4, 
                    rnorm(n)*1.5+6, 
                    rnorm(n)+2))

# compute shift function
sf <- shifthd(data = df, formula = obs ~ gr, nboot = 200, todo = list(c("group1","group2"),c("group2","group3"),
                                                                      c("group3", "group4")))

p <- plot_scat2(df,
                xlabel = "",
                ylabel = "Delta to Local Prediction Gradient",
                alpha = .5,
                shape = 21,
                colour = "grey10",
                fill = "grey90")

p <- plot_hd_linksx(p, sf[[1]], position=1,
                    md_size = 1.5,
                    add_rect = FALSE,
                    rect_alpha = 0.1,
                    rect_col = "grey50",
                    add_lab = TRUE) # superimposed deciles + rectangle

p <- plot_hd_linksx(p, sf[[2]], position=2,
                   md_size = 1.5,
                   add_rect = FALSE,
                   rect_alpha = 0.1,
                   rect_col = "grey50",
                   add_lab = TRUE) # superimposed deciles + rectangles

p <- plot_hd_linksx(p, sf[[3]], position=3,
                    md_size = 1.5,
                    add_rect = FALSE,
                    rect_alpha = 0.1,
                    rect_col = "grey50",
                    add_lab = TRUE) # superimposed deciles + rectangles

And here is the resulting plot :)