I am trying to report the prevalence's and plot the Odds Ratio in a descriptive table something similar to this Post by R for Health Data Science Book. This creates a forest plot. Since I have other values so I cant use finalfit
package but I tried to produce the same table by following the Answer-2 of this Question. I already made the descriptive Table and plotted the odds ratio with dummy values but some of the columns are overlapping, for instance Non-MM and MM
. Secondly, the group Sex and its subgroup Male
is not showing. It might be the formatting issue but I couldn't find it. You can find the snap with highlighted areas and its code, as they mentioned in the code. Thanks
mydf <- data.frame(
SubgroupH = c('Sex', NA, NA, 'Age-Group', NA, NA, NA, NA, NA, NA, NA, NA, 'SIMD', NA, NA, NA, NA, NA),
Subgroup = c(
NA, 'Male', 'Female', NA, '18-25', '26-35', '36-45', '46-55',
'56-65', '66-75', '76-85', '86+', NA, '1', '2', '3', '4', '5'
),
total_cohort = c(NA,18494,3874,NA,23,54,67,43,65,76,23,122,NA,23,43,54,65,34),
non_mm = c(NA,18494,3874,NA,23,54,67,43,65,76,23,122,NA,23,43,54,65,34),
mm = c(NA,18494,3874,NA,64,24,37,43,85,76,32,22,NA,82,54,30,87,20),
cmm = c(NA,18494,3874,NA,44,54,67,43,65,76,23,122,NA,23,43,54,65,34),
ODDs_Ratio = c(NA,0.594,0.5,NA,'-',0.74,0.73,0.63,0.75,0.79,0.43,0.42,NA,'-',0.60,0.64,0.69,0.44),
CI_lower = c(NA,0.394,0.3,NA,'-',0.54,0.67,0.43,0.65,0.76,0.23,0.122,NA,'-',0.43,0.54,0.65,0.34),
CI_upper = c(NA,0.69,0.7,NA,'-',0.94,0.97,0.83,0.95,0.99,0.63,0.52,NA,'-',0.83,0.94,0.95,0.74),
stringsAsFactors = FALSE
)
# Updated plot code
rowseq <- seq(nrow(mydf), 1)
par(mai=c(0.5, 0, 0, 0))
plot(mydf$ODDs_Ratio, rowseq, pch=15,
xlim=c(-10, 12), ylim=c(0, 16),
xlab='', ylab='', yaxt='n', xaxt='n',
bty='n')
axis(1, seq(-2, 2, by=.4), cex.axis=.5)
segments(1, -1, 1, 15.25, lty=3)
segments(mydf$mm, rowseq, mydf$cmm, rowseq)
#mtext('Off-Pump\nCABG Better', 1, line=2.5, at=0, cex=.5, font=2)
#mtext('On-Pump\nCABG Better', 1.5, line=2.5, at=2, cex=.5, font=2)
text(-8, 16.5, "Subgroup", cex=.75, font=2, pos=4)
t1h <- ifelse(!is.na(mydf$SubgroupH), mydf$SubgroupH, '')
text(-8, rowseq, t1h, cex=.75, pos=4, font=3)
t1 <- ifelse(!is.na(mydf$Subgroup), mydf$Subgroup, '')
text(-7.5, rowseq, t1, cex=.75, pos=4)
text(-5, 16.5, "Total Cohort", cex=.75, font=2, pos=4)
t2 <- ifelse(!is.na(mydf$total_cohort), format(mydf$total_cohort, big.mark=","), '')
text(-3, rowseq, t2, cex=.75, pos=2)
text(7.5, 16.5, "NO-MM", cex=.75, font=2, pos=4)
t3 <- ifelse(!is.na(mydf$non_mm), mydf$non_mm, '')
text(7.5, rowseq, t3, cex=.75, pos=4)
text(7.5, 16.5, "MM", cex=.75, font=2, pos=4)
t4 <- ifelse(!is.na(mydf$mm), mydf$mm, '')
text(7.5, rowseq, t4, cex=.75, pos=4)
text(10, 16.5, "CMM", cex=.75, font=2, pos=4)
t5 <- ifelse(!is.na(mydf$cmm), mydf$cmm, '')
text(10, rowseq, t5, cex=.75, pos=4)
text(-1, 16.5, "ODDs_Ratio", cex=.75, font=2, pos=4)
t6 <- ifelse(!is.na(mydf$ODDs_Ratio), with(mydf, paste(ODDs_Ratio, ' (', CI_lower, '-', CI_upper, ')', sep='')), '')
text(3, rowseq, t6, cex=.75, pos=4)
The issue is simply one of moving the columns around a bit, until you get it how you want. A bit of trial and error ensues.
And here is the updated one:
And this is the code I used to create it:
rowseq <- seq(nrow(mydf), 1)
par(mai=c(0.5, 0, 0, 0))
plot(mydf$ODDs_Ratio, rowseq, pch=15,
xlim=c(-10, 12), ylim=c(0, nrow(mydf) + 2),
xlab='', ylab='', yaxt='n', xaxt='n',
bty='n')
axis(1, seq(-2, 2, by=.4), cex.axis=.5)
segments(1, -1, 1, nrow(mydf) + 1, lty=3)
segments(mydf$mm, rowseq, mydf$cmm, rowseq)
text(-8, nrow(mydf) + 1, "Subgroup", cex=.75, font=2, pos=4)
t1h <- ifelse(!is.na(mydf$SubgroupH), mydf$SubgroupH, '')
text(-8, rowseq, t1h, cex=.75, pos=4, font=3)
t1 <- ifelse(!is.na(mydf$Subgroup), mydf$Subgroup, '')
text(-7.5, rowseq, t1, cex=.75, pos=4)
text(-5, nrow(mydf) + 1, "Total Cohort", cex=.75, font=2, pos=4)
t2 <- ifelse(!is.na(mydf$total_cohort), format(mydf$total_cohort, big.mark=","), '')
text(-3, rowseq, t2, cex=.75, pos=2)
text(6, nrow(mydf) + 1, "NO-MM", cex=.75, font=2, pos=4)
t3 <- ifelse(!is.na(mydf$non_mm), mydf$non_mm, '')
text(6, rowseq, t3, cex=.75, pos=4)
text(8.5, nrow(mydf) + 1, "MM", cex=.75, font=2, pos=4)
t4 <- ifelse(!is.na(mydf$mm), mydf$mm, '')
text(8.5, rowseq, t4, cex=.75, pos=4)
text(11, nrow(mydf) + 1, "CMM", cex=.75, font=2, pos=4)
t5 <- ifelse(!is.na(mydf$cmm), mydf$cmm, '')
text(11, rowseq, t5, cex=.75, pos=4)
text(-2, nrow(mydf) + 1, "ODDs_Ratio", cex=.75, font=2, pos=4)
t6 <- ifelse(!is.na(mydf$ODDs_Ratio), with(mydf, paste(ODDs_Ratio, ' (', CI_lower, '-', CI_upper, ')', sep='')), '')
text(2, rowseq, t6, cex=.75, pos=4)