如何在 R 中正确绘制模型流程图

Question

我想为 R 或 Rstudio 中的隔间模型绘制流程图。在搜索了互联网和这个网站后，我能够部分实现以下目标：

http://apprentiss.com/model_diagram/untitled2.png

我的最终目标是实现这一目标： http://apprentiss.com/model_diagram/Untitled.png 所有箭头都必须用字母命名。

这是我当前的图表代码：

感谢您的帮助

library(diagram)

M  <- matrix(nrow = 4, ncol = 4, byrow = TRUE, data = 0)
C <- M
A <- M

M[2, 1] <- paste(expression(beta[0]))
M[3, 2] <- paste(expression(alpha))
M[4, 2] <- paste(expression(a[t]))
M[3, 4] <- paste(expression(rho))
M[1, 3] <- paste(expression(phi1))

C[2, 1] <- 0.0
C[3, 2] <- 0.0
C[4, 2] <- 0.0
C[3, 4] <- 0.0
C[1, 3] <- -0.07
A[2, 1] <- A[3, 2] <- A[3, 4] <- A[1, 3]<-A[4, 2]<-2
A[4, 1] <- 2

col   <- M
col[] <- "black"
col[4, 2] <- "blue"
plotmat(M, pos = c(1,1,2), curve = C, name = c("S","C","R","I"),
        box.size=c(0.05,0.05,0.05,0.05), box.prop = 1,
        arr.lwd=A,my=0.0,mx= 0.0, dtext = c(0.6),arr.length= 0.4,shadow.size = 0,
        lwd = 1, box.lwd = 2, box.cex = 1, cex.txt = 1, 
        arr.lcol = col, arr.col = col, box.type = "circle",
        lend=4)


##======

Answer 1

关于自此问题以来经过的时间 被问到，我预计@Lunik 已经解决了一些问题 其他方式。尽管如此，因为我用这个问题作为练习 当我今天想调查diagram-package 时，我可能会 很好地发布我设法放在一起的解决方案。

这个解决方案的要点是添加一堆额外的节点，即 使附加箭头的规格进入 “空”区域。诀窍是“隐藏”这些额外的节点，这样 它们不会出现在图形表示中，即 基本上是关于为节点选择空名称"" 的问题 我们 不想看到，然后选择使它们“不可见”的颜色

为了获得与所需输出尽可能相似的图，选择了一个共有 13 个节点的解决方案，其中只有 4 个节点是可见的。

.size <- 13
.visible <- c(2, 3, 5, 7)


##  Initiate the matrices:
.A  <- matrix(nrow = .size,
              ncol = .size)
.arr.lwd <- matrix(0, .size, .size)
.curve <-  matrix(0, .size, .size)
.col <- matrix("black", .size, .size)

##  Define the arguments:
.pos <- c(1, 1, 1, 5, 5)
.box.size <- rep(0.05, length = .size)
##  
.name <- rep(x = "", length = .size)
.name[.visible] <- c("S", "C", "R", "I")
##
.box.col <-  rep(x = "white", length = .size)
.box.lcol <- .box.col
.box.lcol[.visible] <- "black"
##  Arrows up from/down to top visible node:
.arr.lwd[2, 1] <- 2
.curve[2, 1] <- 0.05
.A[2, 1] <- ""
.arr.lwd[1, 2] <- 2
.curve[1, 2] <- 0.05
.A[1, 2] <- ""
##  Arrow down from top visible node:
.arr.lwd[3, 2] <- 2
.A[3, 2] <- "beta[0]"
##  Arrows down from the second visible node (from top):
.arr.lwd[5, 3] <- 2
.A[5, 3] <- "alpha"
.arr.lwd[7, 3] <- 2
.A[7, 3] <- "a[t]"
.col[7, 3] <- "blue"
##  Arrows from the leftmost visible node:
.arr.lwd[4, 5] <- 2
.A[4, 5] <- ""
.arr.lwd[2, 5] <- 2
.curve[2, 5] <- -0.07
.A[2, 5] <-  "phi1"
##  Arrows from the rightmost visible node:
.arr.lwd[5, 7] <- 2
.A[5, 7] <- "rho"
.arr.lwd[8, 7] <- 2
.A[8, 7] <- ""
.arr.lwd[12, 7] <- 2
.A[12, 7] <- ""

##  Adjustment of node `6` to remove "gap" from arrow:
.box.size[6] <- 0
.box.col[6] <- "black"
.box.lcol[6] <- "black"


##  An argument to allow fine-tuning of the arrowhead-positions
##  related to "empty" nodes:
.arr.pos <- matrix(0.5, .size, .size)
.empty_places_top <- rbind(
    c(1, 2),
    c(2, 1))
.empty_places_bottom <- rbind(
    c(4, 5),
    c(8, 7),
    c(12, 7))
.arr.pos[.empty_places_top] <- 0.58
.arr.pos[.empty_places_bottom] <- 0.66


##  Create the desired plot.
plotmat(A = .A,
        pos = .pos,
        curve = .curve,
        name = .name,
        box.size = .box.size, 
        box.col = .box.col,
        box.lcol = .box.lcol,
        box.prop = 1,
        arr.lwd = .arr.lwd,
        my = 0.0,
        mx = 0.0,
        dtext = c(0.6),
        arr.type = "triangle",
        arr.pos = .arr.pos,
        arr.length= 0.4,
        shadow.size = 0,
        lwd = 1,
        box.cex = 1,
        cex.txt = 1, 
        arr.lcol = .col,
        arr.col = .col,
        box.type = "circle",
        lend = 4)