## ----setup, include = FALSE--------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) forplo <- function(mat, em='OR', row.labels=NULL, linreg=FALSE, prop=FALSE, pval=NULL, xlim=xlimits, fliprow=NULL, flipbelow1=FALSE, flipsymbol='*', ci.sep='-', ci.lwd=1.5, ci.edge=TRUE, font='sans', groups=NULL, grouplabs=NULL, group.space=1, group.italics=FALSE, indent.groups=NULL, left.align=FALSE, favorlabs=NULL, add.arrow.left=FALSE, add.arrow.right=FALSE, arrow.left.length=3, arrow.right.length=3, arrow.vadj=0, sort=FALSE, char=20, size=1.5, col=1, insig.col='gray', scaledot.by=NULL, scaledot.factor=0.75, diamond=NULL, diamond.col=col, diamond.line=TRUE, add.columns=NULL, add.colnames=NULL, right.bar=FALSE, rightbar.ticks=0, left.bar=TRUE, leftbar.ticks=0, shade.every=NULL, shade.col='red', shade.alpha=0.05, fill.by=NULL, fill.colors=NULL, fill.labs=NULL, legend=FALSE, legend.vadj=0, legend.hadj=0, legend.spacing=1, margin.left=NULL, margin.top=0, margin.bottom=2, margin.right=10, horiz.bar=FALSE, title=NULL, save=FALSE, save.path=NULL, save.name=NULL, save.type='png', save.width=9, save.height=4.5){ # checks if(!class(mat)[1]%in%c('matrix','data.frame','glm','lm','coxph')){ stop('forplo() expects an object of class matrix, data.frame, lm, glm, or coxph.')} if(class(mat)[1]%in%c('matrix','data.frame')){ if(ncol(mat)!=3) stop('forplo() expects a matrix or data.frame with exactly 3 columns (estimate, CI lower bound, CI upper bound)') if(sum(mat[,1]<0)>0&linreg==FALSE){ message('Since column 1 of mat contains values below 0, linreg has been set to TRUE.') linreg <- TRUE } if(class(mat)[1]=='matrix'){ mat <- as.data.frame(mat) } } if(flipbelow1==TRUE&is.null(favorlabs)!=TRUE){stop('favorlabs cannot be used when flipbelow1 is TRUE.')} if(!is.null(favorlabs)&length(favorlabs)!=2){stop('favorlabs should be a character vector of length 2.')} # round function Round <- function(x, digits = 0) { x = x + abs(x) * sign(x) * .Machine$double.eps round(x, digits = digits) } # convert model to data.frame omat <- mat if(class(omat)[1]%in%c('lm','glm')){ pval <- Round(summary(mat)$coef[-1,4],4) pval[pval==0.0000] <- '<0.0001' mat <- cbind(stats::coef(mat),stats::confint(mat))[-1,] colnames(mat) <- c('est','lci','uci') if(stats::family(omat)$family=='gaussian'){linreg <- TRUE} else{ linreg <- FALSE mat <- exp(mat) } } if(class(omat)[1]=='coxph'){ em <- 'HR' pval <- Round(summary(mat)$coef[,5],4) pval[pval<=0.0000] <- '<0.0001' mat <- exp(cbind(stats::coef(mat),stats::confint(mat))) colnames(mat) <- c('est','lci','uci') } # if row.labels are given, replace rownames if(!is.null(row.labels)){ if(length(row.labels)!=nrow(mat)){stop('The length of row.labels should be equal to the number of rows of mat.')} if(any(duplicated(row.labels))==TRUE){ dups <- which(duplicated(row.labels)) row.labels2 <- make.unique(row.labels) ec <- as.numeric(gsub('.*\\.','',row.labels2)[dups]) row.labels[dups] <- paste0(row.labels[dups], unlist(lapply(ec,function(x) paste0(rep(' ',x),collapse='')))) } rownames(mat) <- row.labels} # function to count number of characters charcount <- function(x){ length(unlist(strsplit(as.character(x),''))) } # x coordinate for null line sigt <- 1 # if linear regression if(linreg==TRUE){ if(flipbelow1==TRUE){stop('flipbelow1 cannot be TRUE when linreg is TRUE.')} sigt <- 0 ci.sep <- ifelse(ci.sep=='-',';',ci.sep) if(em=='OR'){em <- expression(hat(beta))} if(!is.null(favorlabs)){stop('favorlabs cannot be used when linreg is TRUE.')} } # if proportion if(prop==TRUE){ sigt <- 0 xlim <- c(0,1) if(em=='OR'){em <- 'Prop.'} if(!is.null(favorlabs)){stop('favorlabs cannot be used when prop is TRUE.')} } # p-value conditions if(!is.null(pval)&length(pval)!=nrow(mat)) stop('The length of pval should be equal to the number of rows of mat') if(!is.null(add.columns)&!is.null(pval)){stop('add.columns cannot be used if pval is not NULL.')} # store original margins opar <- graphics::par()$mar # fill colors if(!is.null(fill.by)){ if(is.null(fill.colors)){stop('fill.colors must be specified if fill.by is not NULL.')} fill.by <- as.numeric(fill.by) fill.colors <- fill.colors[fill.by] } # create vector indicating rows containing diamonds diavec <- rep(0,nrow(mat)) if(!is.null(diamond)){diavec[diamond] <- 1} # if groups are given, modify matrix to add empty rows and labels if(!is.null(groups)){ if(is.null(grouplabs)){stop('grouplabs should be provided when groups is not NULL')} if(length(grouplabs)!=length(unique(groups))){stop('grouplabs should be of equal length to the number of groups.')} grouplabs <- as.character(grouplabs) groups <- as.numeric(groups) mat <- mat[order(groups),] groups <- sort(groups) # indent subgroups by group index if(!is.null(indent.groups)){ if(left.align==FALSE){ message('If indent.groups is not NULL, left.align should be set to TRUE.\n') left.align <- TRUE } iv <- indent.groups rownames(mat)[which(groups%in%iv)] <- paste0(' ',rownames(mat)[which(groups%in%iv)]) grouplabs[iv] <- paste0(' ',grouplabs[iv]) } g.ind <- which(diff(groups)==1) g.start <- c(1,g.ind+1) g.end <- c(g.ind,nrow(mat)) mat2 <- data.frame(matrix(nrow=0,ncol=3)) # since rownames have to be unique, add variable lengths of whitespace as rownames for empty rows for(i in 1:length(g.start)){ spacemat <- data.frame(matrix(NA,nrow=group.space,ncol=3)) colnames(spacemat) <- colnames(mat) m <- rbind(rep(NA,3),mat[g.start[i]:g.end[i],],spacemat) space.names <- character(group.space) for(j in 1:group.space){ space.names[j] <- paste0(rep(' ',i+j*nrow(mat)),collapse='') } rownames(m) <- c(paste0(rep(' ',i),collapse=''),rownames(mat)[g.start[i]:g.end[i]],space.names) mat2 <- rbind(mat2,m) rm(m) } if(!is.null(pval)){ pval2 <- numeric(0) for(i in 1:length(g.start)){ p <- c(NA,pval[g.start[i]:g.end[i]],rep(NA,group.space)) pval2 <- c(pval2,p) rm(p) } opval <- pval pval <- pval2 } if(!is.null(scaledot.by)){ scale2 <- numeric(0) for(i in 1:length(g.start)){ s <- c(NA,scaledot.by[g.start[i]:g.end[i]],rep(NA,group.space)) scale2 <- c(scale2,s) rm(s) } oscale <- scaledot.by scaledot.by <- scale2 } if(!is.null(fill.by)){ fill.colors2 <- character() for(i in 1:length(g.start)){ fc <- c(NA,fill.colors[g.start[i]:g.end[i]],rep(NA,group.space)) fill.colors2 <- c(fill.colors2,fc) rm(fc) } fill.colors <- fill.colors2 } diavec2 <- numeric(0) for(i in 1:length(g.start)){ d <- c(0,diavec[g.start[i]:g.end[i]],rep(0,group.space)) diavec2 <- c(diavec2,d) rm(d) } diavec <- diavec2 omat <- mat mat <- mat2 } lHR <- nrow(mat) if(!is.null(groups)){select <- -which(!rownames(mat)%in%rownames(omat))} else{select <- 1:length(seq(lHR,1))} if(flipbelow1==TRUE){ fliprow <- which(mat[select,1]<1) rownames(mat)[select][fliprow] <- paste0(rownames(mat)[select][fliprow],flipsymbol) } if(!is.null(fliprow)){ for(i in 1:length(fliprow)){ mat[select,][fliprow[i],] <- 1/mat[select,][fliprow[i],c(1,3:2)] } } if(sort==TRUE){ if(!is.null(groups)){stop('sort is not compatible with groups.')} if(!is.null(diamond)){stop('sort is not compatible with diamond.')} sort.index <- order(mat[,1],decreasing=T) mat <- mat[sort.index,] pval <- pval[sort.index] fill.colors <- fill.colors[sort.index] scaledot.by <- scaledot.by[sort.index] } # set par margin.bottom <- ifelse((!is.null(favorlabs)| !is.null(add.arrow.left)| !is.null(add.arrow.right)| legend==TRUE&!is.null(fill.labs))&margin.bottom<5, margin.bottom+3,margin.bottom) margin.right <- ifelse(!is.null(pval)&margin.right<15,15,margin.right) margin.right <- ifelse(!is.null(add.columns), margin.right+3*ncol(data.frame(add.columns)),margin.right) if(is.null(margin.left)){ lablen <- max(sapply(rownames(mat),charcount)) margin.left <- pmin(13,pmax(8,lablen-8)) } margin.top <- ifelse(!is.null(title),3,0) graphics::par(mar=c(margin.bottom,margin.left,margin.top,margin.right)) if(!is.null(margin.right)){graphics::par(mar=c(margin.bottom,margin.left,margin.top,margin.right))} # save plot if(save==TRUE){ if(!save.type%in%c('wmf','.wmf','WMF','png','.png','PNG')){ message('forplo() only accepts png and wmf as save formats. Your plot will not be saved.')} if(save.type%in%c('wmf','.wmf','WMF')){ grDevices::dev.new(save.width,save.height)} if(save.type%in%c('png','.png','PNG')){ grDevices::png(paste0(save.path,save.name,'.png'),width=save.width,height=save.height,units='in',res=300)} graphics::par(mar=c(margin.bottom,margin.left,margin.top,margin.right)) } # plot if(linreg==TRUE){xlimits <- c(min(mat[,2],na.rm=TRUE)*ifelse(min(mat[,2],na.rm=TRUE)<0,1.2,-1.2),max(mat[,3],na.rm=TRUE)*1.2)} else if(linreg==FALSE){ if(min(mat[,2],na.rm=TRUE)==0){ xlimits <- exp(c(min(log(mat[,2]+1e-10),na.rm=TRUE)*1.2,max(log(mat[,3]),na.rm=TRUE)*1.2)) } if(min(mat[,2],na.rm=TRUE)>0){ xlimits <- exp(c(min(log(mat[,2]),na.rm=TRUE)*1.2,max(log(mat[,3]),na.rm=TRUE)*1.2)) } } if(linreg==FALSE&xlim[1]==0){xlim[1] <- 1e-2} HR <- mat[,1] CI <- mat[,2:3] yvec <- seq(lHR,1) plot(y=yvec, x=HR[1:lHR], xlim=xlim, ylim=c(0,lHR+1), pch='', xlab='', yaxt="n", log=ifelse(linreg==TRUE|prop==TRUE,'','x'), ylab="", bty="n", main=title, family=font) # shade rows if(!is.null(shade.every)){ shade_index <- nrow(mat)/shade.every for(s in seq(1,shade_index,2)){ graphics::rect(xlim[1],0.5+shade.every*(s-1), xlim[2],0.5+shade.every+shade.every*(s-1), col=grDevices::adjustcolor(shade.col,alpha.f=shade.alpha),border=FALSE) } } # draw CIs for(i in seq(1,lHR)){ j <- seq(lHR,1)[i] if(is.na(CI[j,1])|diavec[j]==1){next} graphics::arrows(y0=i, x0=CI[j,1], y1=i, x1=CI[j,2], length=ifelse(ci.edge==FALSE,0,0.03),angle=90,code=3,lwd=ci.lwd, lty=1, col=ifelse(!is.null(fill.by),fill.colors[j], ifelse(sigt%in%Round(seq(Round(CI[j,1],3),Round(CI[j,2],3),by=0.001),3),insig.col,1))) } # dotted null line graphics::abline(v=sigt,lty=3) # draw points if(is.null(fill.colors)){ graphics::points(y=yvec[which(diavec==0)],x=HR[1:lHR][which(diavec==0)],pch=char,col=col,cex=size) } if(!is.null(fill.colors)){ graphics::points(y=yvec[which(diavec==0)],x=HR[1:lHR][which(diavec==0)],pch=char, col=fill.colors[which(diavec==0)],cex=size) } # if scaledot.by is given, draw each dot with different size if(!is.null(scaledot.by)){ for(i in 1:length(yvec[which(diavec==0)])){ graphics::points(y=yvec[which(diavec==0)][i],x=HR[1:lHR][which(diavec==0)][i],pch=char, col=ifelse(!is.null(fill.by),fill.colors[which(diavec==0)][i],col), cex=(scaledot.by[which(diavec==0)][i]/max(scaledot.by,na.rm=T))*4*scaledot.factor) } } # draw diamonds if(!is.null(diamond)){ for(i in 1:length(diamond)){ y1 <- yvec[select][diamond[i]] x1 <- CI[,1][select][diamond[i]] x2 <- HR[1:lHR][select][diamond[i]] x3 <- CI[,2][select][diamond[i]] dia.x <- c(x1,x2,x3,x2,x1) dia.y <- c(y1,y1+0.15,y1,y1-0.15,y1) graphics::polygon(dia.x,dia.y,col=diamond.col,border=diamond.col) } if(diamond.line!=FALSE){ graphics::abline(v=x2,lty=3,col=diamond.col) } } # display arrows below x-axis if(add.arrow.left==TRUE){ ex <- paste0(c('\\254',rep('\\276',arrow.left.length)),collapse='') graphics::mtext(side=1, line=1.7-arrow.vadj, parse(text=paste0("''*symbol('",ex,"')*''")),adj=0) } if(add.arrow.right==TRUE){ ex <- paste0(c(rep('\\276',arrow.right.length),'\\256'),collapse='') graphics::mtext(side=1, line=1.7-arrow.vadj, parse(text=paste0("''*symbol('",ex,"')*''")),adj=1) } # display labels below x-axis if(!is.null(favorlabs)){ graphics::mtext(side=1, line=2.5-arrow.vadj, favorlabs[1],adj=0,font=3,family=font) graphics::mtext(side=1, line=2.5-arrow.vadj, favorlabs[2],adj=1,font=3,family=font) } # add legend if(!is.null(fill.labs)&legend==TRUE){ u_int <- graphics::par('usr')[3]+legend.vadj graphics::mtext('Legend',side=4, at=u_int, line=1+legend.hadj, family=font,las=2, font=2) for(f in 1:length(unique(stats::na.omit(fill.colors)))){ graphics::mtext(expression(''*symbol('\267')*''), side=4, at=u_int-(f*.5*legend.spacing), line=1.5+legend.hadj, family=font,las=2, col=unique(stats::na.omit(fill.colors))[f]) graphics::mtext(fill.labs[f], side=4, at=u_int-(f*.5*legend.spacing), line=2+legend.hadj, family=font, las=2) } } # horizontal bar if(horiz.bar==TRUE){graphics::abline(h=0,lty=1)} # left bar if(left.bar==TRUE){ graphics::axis(2,at=seq(lHR,1),las=2,lwd=1,labels=FALSE,lwd.ticks=leftbar.ticks,tick=left.bar) } # write row names and group labels (bold) graphics::axis(2,at=seq(lHR,1),labels=rownames(mat),las=2,family=font, lwd=0,lwd.ticks=FALSE,tick=FALSE, hadj=ifelse(left.align==TRUE,0,NA), line=ifelse(left.align==TRUE,margin.left-2.5,NA)) if(!is.null(grouplabs)){ lab.ind <- which(!rownames(mat)%in%rownames(omat)) lab.ind <- lab.ind[seq(1,length(lab.ind),group.space+1)] graphics::axis(2,at=seq(lHR,1)[lab.ind],labels=grouplabs,las=2,family=font,font=ifelse(group.italics==TRUE,4,2), lwd=ifelse(left.align==TRUE,0,left.bar*1), hadj=ifelse(left.align==TRUE,0,NA), line=ifelse(left.align==TRUE,margin.left-2,NA)) } graphics::axis(4,at=lHR+1,labels=em,las=2,line=1,tick=F,font=2,las=2,family=font) graphics::axis(4,at=lHR+1,labels='95% CI',line=4,tick=F,font=2,las=2,family=font) # write CIs graphics::axis(4,at=seq(lHR,1)[select],labels=sprintf('%.2f',Round(stats::na.omit(mat[,1]),2)),las=2,line=1, tick=right.bar,lwd.ticks=rightbar.ticks,family=font) graphics::axis(4,at=seq(lHR,1)[select],labels=paste0(sprintf('[%.2f',Round(stats::na.omit(mat[,2]),2)),ci.sep),las=2,line=4,tick=F,family=font) graphics::axis(4,at=seq(lHR,1)[select],labels=paste0(ifelse(max(sapply(Round(stats::na.omit(mat[,2]),2),charcount))<5,' ',' '), sprintf('%.2f',Round(stats::na.omit(mat[,3]),2)),']'),las=2,line=6,tick=F,family=font) # add additional columns if(!is.null(add.columns)){ startline=9 for(k in 1:ncol(data.frame(add.columns))){ if(!is.null(add.colnames)){graphics::axis(4,at=lHR+1,labels=add.colnames[k],las=2,line=startline,tick=F,font=2,family=font)} graphics::axis(4,at=seq(lHR,1)[select],labels=data.frame(add.columns)[,k],las=2,line=startline,tick=F,family=font) startline <- startline+3 } } # add p-values if(!is.null(pval)){ graphics::axis(4,at=lHR+1,labels='p-value',line=9,tick=F,font=2,las=2,family=font) graphics::axis(4,at=seq(lHR,1),labels=pval,las=2,line=9,tick=F,family=font) } # end saving plot if type is .wmf if(save==TRUE){ if(save.type%in%c('wmf','.wmf','WMF')){grDevices::savePlot(paste0(save.path,save.name,'.wmf'),type='wmf')} grDevices::dev.off() } # restore original plot settings graphics::par(mar=opar) graphics::layout(1) } ## ---- fig.height=5,fig.width=8------------------------------------------------ exdf <- cbind(OR=c(1.21,0.90,1.02, 1.54,1.32,0.79,1.38,0.85,1.11, 1.58,1.80,2.27), LCI=c(0.82,0.61,0.66, 1.08,0.91,0.48,1.15,0.39,0.91, 0.99,1.48,0.92), UCI=c(1.79,1.34,1.57, 2.19,1.92,1.32,1.64,1.87,1.34, 2.54,2.19,5.59), groups=c(1,1,1, 2,2,2,2,2,2, 3,3,3)) exdf <- data.frame(exdf) rownames(exdf) <- c('Barry, 2005', 'Frances, 2000', 'Rowley, 1995', 'Biro, 2000', 'Crowe, 2010', 'Harvey, 1996', 'Johns, 2004', 'Parr, 2002', 'Zhang, 2011', 'Flint, 1989', 'Mac Vicar, 1993', 'Turnbull, 1996') knitr::kable(exdf) forplo(exdf[,1:3]) ## ---- fig.height=5,fig.width=8------------------------------------------------ forplo(exdf[,1:3], groups=exdf$groups, grouplabs=c('Low risk of bias', 'Some concerns', 'High risk of bias')) ## ---- fig.height=6,fig.width=9------------------------------------------------ logORs <- round(log(exdf$OR),2) SE <- round((log(exdf$UCI)-logORs)/1.96,2) meta1 <- meta::metagen(logORs[1:3],SE[1:3]) meta2 <- meta::metagen(logORs[4:9],SE[4:9]) meta3 <- meta::metagen(logORs[10:12],SE[10:12]) metatot <- meta::metagen(logORs,SE) # create new data.frame exdf2 <- exdf exdf2$logORs <- logORs exdf2$SE <- SE exdf2$weights <- round(metatot$w.random/sum(metatot$w.random)*100,2) exdf2 <- rbind(subset(exdf2,groups==1), c(round(exp(meta1$TE.random),2), round(exp(meta1$lower.random),2), round(exp(meta1$upper.random),2), 1,round(meta1$TE.random,2),round(meta1$seTE.random,2),sum(exdf2$weights[1:3])), subset(exdf2,groups==2), c(round(exp(meta2$TE.random),2), round(exp(meta2$lower.random),2), round(exp(meta2$upper.random),2), 2,round(meta2$TE.random,2),round(meta2$seTE.random,2),sum(exdf2$weights[4:9])), subset(exdf2,groups==3), c(round(exp(meta3$TE.random),2), round(exp(meta3$lower.random),2), round(exp(meta3$upper.random),2), 3,round(meta3$TE.random,2),round(meta3$seTE.random,2),sum(exdf2$weights[10:12])), c(round(exp(metatot$TE.random),2), round(exp(metatot$lower.random),2), round(exp(metatot$upper.random),2), 4,round(metatot$TE.random,2),round(metatot$seTE.random,2),100)) exdf2 <- data.frame(exdf2) rownames(exdf2)[c(4,11,15,16)] <- c('Diamond 1','Diamond 2','Diamond 3','Diamond 4') # show new data.frame knitr::kable(exdf2) forplo(exdf2[,1:3], groups=exdf2$groups, grouplabs=c('Low risk of bias', 'Some concerns', 'High risk of bias', 'Overall'), left.align=TRUE, add.columns=exdf2[,5:7], add.colnames=c('log(OR)','SE','Weights'), col=2, ci.edge=FALSE, diamond=c(4,11,15,16), diamond.col='#b51b35') ## ---- fig.height=6,fig.width=9------------------------------------------------ weights <- exdf2$weights weights[c(4,11,15,16)] <- NA forplo(exdf2[,1:3], groups=exdf2$groups, grouplabs=c('Low risk of bias', 'Some concerns', 'High risk of bias', 'Overall'), left.align=TRUE, add.columns=exdf2$weights, add.colnames=c('Weights'), col=2, char=15, ci.edge=FALSE, diamond=c(4,11,15,16), diamond.col='#b51b35', scaledot.by=weights, favorlabs=c('Favours other models','Favours midwife-led'), shade.every=1) ## ---- fig.height=6,fig.width=9------------------------------------------------ forplo(exdf2[,1:3], groups=exdf2$groups, grouplabs=c('Low risk of bias', 'Some concerns', 'High risk of bias', 'Overall'), left.align=TRUE, add.columns=exdf2$weights, add.colnames=c('Weights'), ci.edge=FALSE, diamond=c(4,11,15,16), diamond.col=adjustcolor(4,0.8), scaledot.by=weights, favorlabs=c('Favours other models','Favours midwife-led'), shade.every=1, shade.col='gray', font='Garamond', fill.by=exdf2$groups, fill.colors=c('#f54251','#1403fc','#fc03a5',1), title='Example of a plot with custom colors and font', margin.left=9) ## ---- fig.height=6,fig.width=9------------------------------------------------ forplo(exdf2[,1:3], groups=exdf2$groups, grouplabs=c('Low risk of bias', 'Some concerns', 'High risk of bias', 'Overall'), left.align=TRUE, add.columns=exdf2$weights, add.colnames=c('Weights'), ci.edge=FALSE, diamond=c(4,11,15,16), diamond.col=adjustcolor(4,0.8), scaledot.by=weights, favorlabs=c('Favours other models','Favours midwife-led'), add.arrow.left=TRUE, add.arrow.right=TRUE, arrow.left.length=8, arrow.right.length=16, shade.every=1, shade.col='gray', font='Garamond', fill.by=exdf2$groups, fill.colors=c('#f54251','#1403fc','#fc03a5',1), fill.labs=c('Low RoB','Some concerns','High RoB','Overall'), legend=TRUE, legend.vadj=1, legend.hadj=1, legend.spacing=2.5, title='Example of a plot with custom colors and font', margin.left=9) ## ---- fig.height=3.5,fig.width=7.5-------------------------------------------- mod1 <- lm(Sepal.Length~Sepal.Width+Species+Petal.Width+Petal.Length,iris) mod2 <- glm(as.numeric(status==2)~scale(age)+sex+ ph.ecog+scale(ph.karno)+scale(pat.karno)+ scale(meal.cal)+scale(wt.loss),survival::lung,family=binomial) survmod <- survival::coxph(survival::Surv(time,status)~scale(age)+sex+ ph.ecog+scale(ph.karno)+scale(pat.karno)+ scale(meal.cal)+scale(wt.loss),survival::lung) ## ---- fig.height=3.5,fig.width=7.5-------------------------------------------- forplo(mod1) ## ---- fig.height=3.5,fig.width=7.5-------------------------------------------- forplo(mod1, row.labels=c('Sepal width','Versicolor','Virginica','Petal width','Petal length'), groups=c(1,2,2,3,3), grouplabs=c('Sepal traits','Species','Petal traits'), shade.every=1, shade.col='gray', left.align=TRUE, xlim=c(-2,2), title='Linear regression with grouped estimates') ## ---- fig.height=5,fig.width=8.5---------------------------------------------- forplo(mod2, sort=TRUE, favorlabs=c('Lower mortality','Higher mortality'), shade.every=1, ci.edge=FALSE, char=18, row.labels=c('Age', 'Female sex', 'ECOG performance', 'Karnofsky performance,\nphysician-assessed', 'Karnofsky performance,\npatient-assessed', 'Calories per meal', 'Weight loss, last 6m'), title='Logistic regression, sorted by OR') ## ---- fig.height=5,fig.width=8.5---------------------------------------------- forplo(survmod, row.labels=c('Age', 'Female sex', 'ECOG performance', 'Karnofsky performance,\nphysician-assessed', 'Karnofsky performance,\npatient-assessed', 'Calories per meal', 'Weight loss, last 6m'), sort=TRUE, flipbelow1=TRUE, flipsymbol=', inverted', fill.by=c(1,1,2,2,2,3,3), fill.colors=c(1,2,'#3483eb'), scaledot.by=abs(coef(survmod)), shade.every=2, font='Helvetica', title='Cox regression, sorted by HR, inverted HRs<1, scaled dots by effect size', right.bar=TRUE, rightbar.ticks=TRUE, leftbar.ticks=TRUE)