R中多重/并行中介模型的绘制示意图

Question

我想在 R 中绘制一个可发布的并行中介模型图。

我改编了这里提供的 Diagrammer + Graphviz 代码 https://stackoverflow.com/questions/46465752/drawing-simple-mediation-diagram-in-r，但我似乎没有得到预期的输出。我认为我在 rank 论点上做错了。

我的目标是让预测变量和结果在底部，所有三个中介在上面的一条垂直线上。

以下代码几乎可以理解，但是将两个中介放在下面而不是上面。如果从 xx 到 yy 的箭头至少会落在盒子的中间，这也会起作用。

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)

输出：

我试过的第二个版本，导致所有调解员都处于水平线而不是垂直线：

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)

输出：

帮助和对排名部分的一点投入将是惊人的或解决此问题的替代方案。 谢谢！