How to properly draw a model flow diagram in R

1k views Asked by At

I want to draw a flow diagram for a compartmental model in R or Rstudio. After searching the the internet and this website I was able to partially achieve the following:

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

My final goal is to achieve this: http://apprentiss.com/model_diagram/Untitled.png All arrows must be named with a letter.

and here is my current code for the diagram:

Thanks for your help

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)


##======
1

There are 1 answers

1
Lars Arne Jordanger On BEST ANSWER

With regard to the amount of time that has passed since this question was asked, I anticipate that @Lunik has resolved the issue in some other manner. Nevertheless, since I used this question as an exercise when I today wanted to investigate the diagram-package, I might as well post the solution I managed to put together.

The main point in this solution is to add a bunch of extra nodes, that enables the specification of the additional arrows going out into "empty" areas. The trick is to "hide" these extra nodes such that they don't show up on the graphical representation, i.e. it's basically a question about selecting empty names "" for the nodes that we don't want to see, and then select colours that makes them "invisible"

In order to get a plot as similar as possible to the desired output, a solution with altogether 13 nodes were selected, where only 4 of them will be visible.

.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)