i want draw flow diagram compartmental model in r or rstudio. after searching the internet , website able partially achieve following:
http://apprentiss.com/model_diagram/untitled2.png
my final goal achieve this: http://apprentiss.com/model_diagram/untitled.png arrows must named letter.
and here current code diagram:
thanks help
library(diagram) m <- matrix(nrow = 4, ncol = 4, byrow = true, data = 0) c <- m <- 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) ##======
with regard amount of time has passed since question asked, anticipate @lunik has resolved issue in other manner. nevertheless, since used question exercise when today wanted investigate diagram-package, might post solution managed put together.
the main point in solution add bunch of nodes, enables specification of additional arrows going out "empty" areas. trick "hide" these nodes such don't show on graphical representation, i.e. it's question selecting empty names "" nodes don't want see, , select colours makes them "invisible"
in order plot similar possible desired output, solution altogether 13 nodes selected, 4 of them visible.
.size <- 13 .visible <- c(2, 3, 5, 7) ## initiate matrices: .a <- matrix(nrow = .size, ncol = .size) .arr.lwd <- matrix(0, .size, .size) .curve <- matrix(0, .size, .size) .col <- matrix("black", .size, .size) ## define 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 from/down 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 top visible node: .arr.lwd[3, 2] <- 2 .a[3, 2] <- "beta[0]" ## arrows down 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 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 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` remove "gap" arrow: .box.size[6] <- 0 .box.col[6] <- "black" .box.lcol[6] <- "black" ## argument allow fine-tuning of arrowhead-positions ## related "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 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, = 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)
Comments
Post a Comment