Git Product home page Git Product logo

Comments (1)

greggyfromtheblock avatar greggyfromtheblock commented on May 20, 2024

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 :)
478cf8e9-50c1-4ba5-a093-d6e709367580

from rogme.

Related Issues (10)

Recommend Projects

  • React photo React

    A declarative, efficient, and flexible JavaScript library for building user interfaces.

  • Vue.js photo Vue.js

    🖖 Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.

  • Typescript photo Typescript

    TypeScript is a superset of JavaScript that compiles to clean JavaScript output.

  • TensorFlow photo TensorFlow

    An Open Source Machine Learning Framework for Everyone

  • Django photo Django

    The Web framework for perfectionists with deadlines.

  • D3 photo D3

    Bring data to life with SVG, Canvas and HTML. 📊📈🎉

Recommend Topics

  • javascript

    JavaScript (JS) is a lightweight interpreted programming language with first-class functions.

  • web

    Some thing interesting about web. New door for the world.

  • server

    A server is a program made to process requests and deliver data to clients.

  • Machine learning

    Machine learning is a way of modeling and interpreting data that allows a piece of software to respond intelligently.

  • Game

    Some thing interesting about game, make everyone happy.

Recommend Org

  • Facebook photo Facebook

    We are working to build community through open source technology. NB: members must have two-factor auth.

  • Microsoft photo Microsoft

    Open source projects and samples from Microsoft.

  • Google photo Google

    Google ❤️ Open Source for everyone.

  • D3 photo D3

    Data-Driven Documents codes.