-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy path2_consort.R
130 lines (120 loc) · 6.03 KB
/
2_consort.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
# 2_consort.R
# CONSORT flow diagram
# called by 2_descriptive_stats.Rmd
library(diagram)
# check of those without reason but not randomised
filter(for_consort, is.na(reason), is.na(randomised))
# get numbers
n_approached = nrow(for_consort)
n_randomised = sum(is.na(for_consort$randomised)==FALSE)
n_uc = sum(for_consort$randomised == 'Usual care', na.rm = TRUE)
n_nm = sum(for_consort$randomised == 'New model of care', na.rm = TRUE)
# exclusion numbers prior to randomisation
exclusion_n = filter(for_consort,
is.na(randomised), # must be prior to randomisation
!is.na(reason)) %>%
group_by(reason) %>%
tally() %>%
ungroup()
# withdrawn after randomisation
withdrawn.uc = nrow(filter(for_consort, !is.na(randomised), randomised == 'Usual care', !is.na(reason)))
withdrawn.nm = nrow(filter(for_consort, !is.na(randomised), randomised == 'New model of care', !is.na(reason)))
# phone numbers
analysed.uc.phone = nrow(filter(for_consort,
!is.na(phone_date), # got phoned
!is.na(randomised), # got randomised
randomised == 'Usual care'))
analysed.nm.phone = nrow(filter(for_consort,
!is.na(phone_date), # got phoned
!is.na(randomised), # got randomised
randomised == 'New model of care'))
# notes numbers
analysed.uc.notes = nrow(filter(for_consort,
!is.na(review_date), # got notes
!is.na(randomised), # got randomised
randomised == 'Usual care'))
analysed.nm.notes = nrow(filter(for_consort,
!is.na(review_date), # got notes
!is.na(randomised), # got randomised
randomised == 'New model of care'))
# deaths
died.uc = nrow(filter(for_consort, !is.na(randomised), randomised == 'Usual care', reason == 'Died'))
died.nm = nrow(filter(for_consort, !is.na(randomised), randomised == 'New model of care', reason == 'Died'))
## Add per protocol definition
# patients that attended their Fibroscan appointment and were able to be scanned
pp.uc = analysed.uc.notes # include all as PP does not apply because "treatment" is usual care, so it is whatever they did
pp.nm = nrow(filter(for_consort, randomised=='New model of care', pp==TRUE)) #
# labels
b = c('Enrollment', 'Allocation', 'Follow-up', 'Analysis')
l1 = paste('Approached\n(n=', n_approached, ')', sep='')
l3 = paste('Randomised\n(n=', n_randomised, ')', sep='')
l4 = paste('Usual care\n(n=', n_uc, ')', sep='')
l5 = paste('New model\n(n=', n_nm, ')', sep='')
l6 = paste('Withdrawn (n=', withdrawn.uc, ')\n', # usual care lost to fu
'- Died (n=', died.uc,')', sep='')
l7 = paste('Withdrawn (n=', withdrawn.nm, ')\n', # new mode lost to fu
'- Died (n=', died.nm,')', sep='')
l8 = paste('Analysed\n',
'- Telephone follow-up (n=', analysed.uc.phone,')\n',
'- Routine data (n=', analysed.uc.notes,')\n',
'- Per protocol (n=', pp.uc,')', sep='')
l9 = paste('Analysed\n',
'- Telephone follow-up (n=', analysed.nm.phone,')\n',
'- Routine data (n=', analysed.nm.notes,')\n',
'- Per protocol (n=', pp.nm,')', sep='')
# exclusion labels
l2 = paste('Excluded (n=', sum(exclusion_n$n), ')\n',
'- Could not be contacted (n=', filter(exclusion_n, reason == 'Could not be contacted')$n, ')\n',
'- Risky alcohol or liver problem (n=', filter(exclusion_n, reason == 'AUDIT (risky alcohol) or liver problem')$n, ')\n',
'- Seen other specialist (n=', filter(exclusion_n, reason == 'Have been evaluated in a specialist hepatology clinic in the previous 12 months')$n, ')\n',
'- Plans to move (n=', filter(exclusion_n, reason == 'Plans to move')$n, ')\n',
'- Terminal illness (n=', filter(exclusion_n, reason == 'Terminal illness')$n, ')\n',
'- No time (n=', filter(exclusion_n, reason == 'No time to take part')$n, ')\n',
'- Other reasons (n=', filter(exclusion_n, reason == 'Other')$n, ')', sep='')
labels = c(l1, l2, l3, l4, l5, l6, l7, l8, l9, b)
n.labels = length(labels)
### make data frame of box chars
frame = read.table(sep='\t', stringsAsFactors=F, skip=0, header=T, text='
i x y box.col box.type box.prop box.size
1 0.5 0.94 white square 0.25 0.16
2 0.77 0.79 white square 0.47 0.23
3 0.5 0.64 white square 0.25 0.15
4 0.26 0.47 white square 0.23 0.2
5 0.76 0.47 white square 0.23 0.2
6 0.26 0.29 white square 0.2 0.2
7 0.76 0.29 white square 0.2 0.2
8 0.26 0.12 white square 0.315 0.2
9 0.76 0.12 white square 0.315 0.2
10 0.1 0.94 light blue round 0.72 0.035
11 0.51 0.55 light blue round 0.7 0.035
12 0.51 0.38 light blue round 0.7 0.035
13 0.51 0.22 light blue round 0.7 0.035')
pos = as.matrix(subset(frame, select=c(x, y)))
M = matrix(nrow = n.labels, ncol = n.labels, byrow = TRUE, data = 0)
M[3, 1] = "' '"
M[4, 3] = "' '"
M[5, 3] = "' '"
M[6, 4] = "' '"
M[7, 5] = "' '"
M[8, 6] = "' '"
M[9, 7] = "' '"
tcol = rep('black', n.labels)
to.blank = c(2,4:9)
tcol[to.blank] = 'transparent' # blank some boxes to add text as right aligned
# function to repeat figure
make_figure = function(){
par(mai=c(0,0.04,0.04,0.04))
plotmat(M, pos = pos, name = labels, lwd = 1, shadow.size=0, curve=0,
box.lwd = 2, cex.txt = 1, box.size = frame$box.size, box.col=frame$box.col,
box.type = frame$box.type, box.prop = frame$box.prop, txt.col = tcol)
# add left-aligned text; -0.185 controls the horizontal indent
for (i in to.blank){
text(x=pos[i,1] - 0.185, y=pos[i,2], adj=c(0,0.5), labels=labels[i]) # minus controls text position
}
# extra arrow to excluded
shape::Arrows(x0=0.5, x1=0.53, y0=0.82, y1=0.82, arr.width = 0.25, arr.length=0.19, arr.typ='triangle')
}
#
jpeg('figures/consort_flow.jpg', width=7.5, height=8, units='in', res=500, quality=100)
make_figure()
dev.off()