У меня был подобный запрос для этих типов диаграмм каждую неделю. Я сделал то, что предлагает Skullkey здесь, а затем я приготовил это. Возможно, он не такой хороший, как тот, который вы показываете, но в нем есть основная идея.
consort.dia <- function(
screened=45,
eligible=46,
neligible=47,
interested=48,
ninterested=49,
consented=50,
nconsented=51,
treat=52,
control=53
){
require(diagram)
openplotmat(main="Consort Diagram")
elpos<-coordinates (c(1,3,3,4,5))
fromto <- matrix(ncol=2,byrow=TRUE,
data=c(1,2,
1,3,
1,4,
2,5,
2,6,
2,7,
5,8,
5,9,
5,10,
8,12,
8,13
)
)
nr <-nrow(fromto)
arrpos <- matrix(ncol=2,nrow=nr)
for (i in 1:nr)
arrpos[i,] <- straightarrow (
to=elpos[fromto[i,2],],
from=elpos[fromto[i,1],],
lwd=2,arr.pos=0.6,
arr.length=0.5
)
textrect (elpos[1,],radx=.094,rady=.05,lab=paste("Screened\n",screened))
textrect (elpos[2,],radx=.094,rady=.05,lab=paste("Eligible\n",eligible))
textrect (elpos[3,],radx=.094,rady=.05,lab=paste("Not Eligible\n",neligible))
textrect (elpos[4,],radx=.094,rady=.05,lab=paste("Screening \n Incomplete\n",screened-(neligible+eligible)))
textrect (elpos[5,],radx=.094,rady=.05,lab=paste("Interested\n",interested))
textrect (elpos[6,],radx=.094,rady=.05,lab=paste("Not Interested\n",ninterested))
textrect (elpos[8,],radx=.094,rady=.05,lab=paste("Consented\n",consented))
textrect (elpos[9,],radx=.094,rady=.05,lab=paste("Not Consented\n",nconsented))
textrect (elpos[12,],radx=.094,rady=.05,lab=paste("Treatment\n",treat))
textrect (elpos[13,],radx=.094,rady=.05,lab=paste("Control\n",control))
textrect (elpos[7,],radx=.094,rady=.05,lab=paste("Unable to \nReach\n",eligible-{interested+ninterested}))
textrect (elpos[10,],radx=.094,rady=.05,lab=paste("In Progress\n",interested-{consented+nconsented}))
}
Выводит это: