rplotstatisticsregressionforest-plots

Forest Plot or Plotting OddsRatio in a Table


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 enter image description here

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)

Solution

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

    Here's the original plot: enter image description here

    And here is the updated one:

    enter image description here

    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)