Drawing diagram of a multiple / parallel mediation model in R

Question

I want to draw a publication-ready diagram of a parallel mediation model in R.

I adapted the Diagrammer + Graphviz Code provided here https://stackoverflow.com/questions/46465752/drawing-simple-mediation-diagram-in-r, but I do not seem to get the expected output. I think I am doing something wrong with the rank argument.

My goal is to have the predictor and outcome at the bottom and all three mediators in one vertical line above.

This following code almost gets it, but puts two mediatiors below instead on top. This would also work, if the arrow from xx to yy would at least land in the middle of the box.

med_data <-
  data.frame(
    lab_x   = "XXXXXX",
    lab_m1   = "MMMMMM 1",
    lab_m2   = "MMMMMM 2",
    lab_m3   = "MMMMMM 3",
    lab_y   = "YYYYYYY",
    coef_xm1 = "0.11*",
    coef_m1y = "0.11*",
    coef_xm2 = "0.22*",
    coef_m2y = "0.22*",
    coef_xm3 = "0.33*",
    coef_m3y = "0.33*",
    coef_xy = "0.66*"
  )


med_diagram <- function(data, height = .75, width = 2, 
                        graph_label = NA, node_text_size = 12, 
                        edge_text_size = 12, color = "black", 
                        ranksep = .2, minlen = 3){
  
  require(glue)
  require(DiagrammeR)
  
  data$height  <- height   # node height
  data$width   <- width    # node width
  data$color   <- color    # node + edge border color
  data$ranksep <- ranksep  # separation btwn mediator row and x->y row
  data$minlen  <- minlen   # minimum edge length
  
  data$node_text_size  <- node_text_size
  data$edge_text_size  <- edge_text_size
  
  data$graph_label <- ifelse(is.na(graph_label), "", 
                             paste0("label = '", 
                                    graph_label, "'"))
  
  diagram_out <- glue::glue_data(data,
                                 "digraph flowchart {
      fontname = Helvetica
      <<graph_label>>
      graph [ranksep = <<ranksep>>]

      # node definitions with substituted label text
      node [fontname = Helvetica, shape = rectangle, fixedsize = TRUE, 
      width = <<width>>, height = <<height>>, fontsize = <<node_text_size>>, 
      color = <<color>>]        
        mm1 [label = '<<lab_m1>>']
        xx [label = '<<lab_x>>']
        yy [label = '<<lab_y>>']
        mm2 [label = '<<lab_m2>>']
        mm3 [label = '<<lab_m3>>']

      # edge definitions with the node IDs
      edge [minlen = <<minlen>>, fontname = Helvetica, 
      fontsize = <<edge_text_size>>, color = <<color>>]
        xx -> yy [label = '<<coef_xy>>'];
        mm1 -> yy [label = '<<coef_m1y>>'];
        xx -> mm1 [label = '<<coef_xm1>>'];
        mm2 -> yy [label = '<<coef_m2y>>'];
        xx -> mm2 [label = '<<coef_xm2>>'];
        mm3 -> yy [label = '<<coef_m3y>>'];
        xx -> mm3 [label = '<<coef_xm3>>'];
        
      rankdir = LR;
      { rank = same; mm1; mm2; mm3 }
      
      }

      ", .open = "<<", .close = ">>")  
  
  
  DiagrammeR::grViz(diagram_out)  
}

med_diagram(med_data)

Output, Mediation Model 1:

A second version I tried, led to all mediators being in a horizontal instead of a vertical line:

med_data <-
  data.frame(
    lab_x   = "XXXXXX",
    lab_m1   = "MMMMMM 1",
    lab_m2   = "MMMMMM 2",
    lab_m3   = "MMMMMM 3",
    lab_y   = "YYYYYYY",
    coef_xm1 = "0.11*",
    coef_m1y = "0.11*",
    coef_xm2 = "0.22*",
    coef_m2y = "0.22*",
    coef_xm3 = "0.33*",
    coef_m3y = "0.33*",
    coef_xy = "0.66* (.16)"
  )


med_diagram <- function(data, height = .75, width = 2, 
                        graph_label = NA, node_text_size = 12, 
                        edge_text_size = 12, color = "black", 
                        ranksep = .2, minlen = 3){
  
  require(glue)
  require(DiagrammeR)
  
  data$height  <- height   # node height
  data$width   <- width    # node width
  data$color   <- color    # node + edge border color
  data$ranksep <- ranksep  # separation btwn mediator row and x->y row
  data$minlen  <- minlen   # minimum edge length
  
  data$node_text_size  <- node_text_size
  data$edge_text_size  <- edge_text_size
  
  data$graph_label <- ifelse(is.na(graph_label), "", 
                             paste0("label = '", 
                                    graph_label, "'"))
  
  diagram_out <- glue::glue_data(data,
                                 "digraph flowchart {
      fontname = Helvetica
      <<graph_label>>
      graph [ranksep = <<ranksep>>]

      # node definitions with substituted label text
      node [fontname = Helvetica, shape = rectangle, fixedsize = TRUE, 
      width = <<width>>, height = <<height>>, fontsize = <<node_text_size>>, 
      color = <<color>>]        
        mm1 [label = '<<lab_m1>>']
        xx [label = '<<lab_x>>']
        yy [label = '<<lab_y>>']
        mm2 [label = '<<lab_m2>>']
        mm3 [label = '<<lab_m3>>']

      # edge definitions with the node IDs
      edge [minlen = <<minlen>>, fontname = Helvetica, 
      fontsize = <<edge_text_size>>, color = <<color>>]
        xx -> yy [label = '<<coef_xy>>'];
        mm1 -> yy [label = '<<coef_m1y>>'];
        xx -> mm1 [label = '<<coef_xm1>>'];
        mm2 -> yy [label = '<<coef_m2y>>'];
        xx -> mm2 [label = '<<coef_xm2>>'];
        mm3 -> yy [label = '<<coef_m3y>>'];
        xx -> mm3 [label = '<<coef_xm3>>'];
        

      { rank = max; xx; yy}
      }

      ", .open = "<<", .close = ">>")  
  
  
  DiagrammeR::grViz(diagram_out)  
}

med_diagram(med_data)

Output, Mediation Model 2:

Help and a little input on the rank part would be amazing or an alternative package for solving this issue.

Update: Here is an example picture: Example Model

Answer 1

I may have missed something AND this might be coming in far too late, but I believe simply reordering the specification in the original script will help. For instance...

  mm1 [label = '<<lab_m1>>']
  mm2 [label = '<<lab_m2>>']
  mm3 [label = '<<lab_m3>>']
  xx [label = '<<lab_x>>']
  yy [label = '<<lab_y>>']

...should place the direct pathway at the bottom of the diagram. Though the resulting arrows may then be curved.

Answer 2

Best references for ranking: https://www.graphviz.org/pdf/dotguide.pdf (esp. p. 7 & 15) and https://www.graphviz.org/docs/attrs/rank/
All-in-all not a Graphviz strength. I do not use Diagrammer, but the Graphviz code below will probably translate pretty easily.

digraph N{
  splines=false // straight line edges
  rankdir=TB    // same as default
  nodesep=1.2
  ranksep=.2
  node [shape=rect]
 
  // set these nodes one per rank
  mm1 -> mm2 [style=invis]
  mm2 -> mm3 [style=invis]

  xxxx -> mm1:w
  xxxx -> mm2:w
  xxxx -> mm3:w
  mm1:e -> yyyy
  mm2:e -> yyyy
  mm3:e -> yyyy
  {
   rank=sink  //  rank=source   if you want these nodes on top
   // bogus node is needed to keep left-right symmetry, not sure why
   bogus [style=invis shape=plain]
   xxxx -> yyyy
   xxxx -> bogus [style=invis]
   bogus -> yyyy [style=invis]
  }
}

Giving: