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

How to properly draw a model flow diagram in R

我想在 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)


##======

关于这个问题已经过了多少时间 被问到,我预计@Lunik 已经在某些方面解决了这个问题 其他方式。尽管如此,因为我用这个问题作为练习 当我今天想研究 diagram-package 时,我可能会 好吧 post 我设法组合的解决方案。

这个解决方案的重点是添加一堆额外的节点,即 启用附加箭头的规范 "empty" 个区域。诀窍是 "hide" 这些额外的节点,这样 它们不会出现在图形表示上,即它是 基本上是关于节点 selecting 空名称 "" 的问题 我们 不想看,然后 select 颜色使它们 "invisible"

为了获得与所需输出尽可能相似的绘图,select编辑了一个总共有 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)