From f46deae32b571e53740f57d4dab1dd010e026439 Mon Sep 17 00:00:00 2001 From: jessexknight Date: Thu, 11 Nov 2021 16:02:01 -0500 Subject: [PATCH] code: add boxplots for api & related changes, part of #19 --- code/analysis/data.r | 17 ++++++++++++++- code/analysis/meta.r | 12 ++++++---- code/analysis/plot.r | 52 +++++++++++++++++++++----------------------- 3 files changed, 49 insertions(+), 32 deletions(-) diff --git a/code/analysis/data.r b/code/analysis/data.r index 9299925..268a4b6 100644 --- a/code/analysis/data.r +++ b/code/analysis/data.r @@ -67,6 +67,7 @@ load.main.data = function(...){ X = make.diff.any(X) X = make.act.kp(X) X = make.risk(X) + X = make.age.n.cat(X) X = make.act.n.cat(X) X = make.act.n.sex.max(X) X = make.turnover(X) @@ -104,6 +105,20 @@ get.cols.co = function(X){ return(co.names[co.names %in% colnames(X)]) } +make.age.n.cat = function(X){ + X$age.n.cat = factor(mapply(function(n){ + if (is.na(n)) { return(NA) } + if (n == 1) { return(1) } + if (n >= 2 & n <= 3){ return(2) } + if (n >= 4 & n <= 12){ return(3) } + if (n >= 13) { return(4) } + },X$age.n), + levels = c(1,2,3,4), + labels = c('1','2-3','4-12','13+') + ) + return(X) +} + make.act.n.cat = function(X){ X$act.n.cat = factor(mapply(function(n,sex,kp){ if (is.na(n) | is.na(sex)) { return(NA) } @@ -313,7 +328,7 @@ make.api.data = function(XA,which='chi'){ values_drop_na=TRUE) %>% mutate(t=as.numeric(name)+api.dt) %>% mutate(t.cat=cut(t,c(tcut,100),as.character(tcut),right=FALSE)) %>% - mutate(art.cd4=relevel(factor(art.cd4),ref='symp')) + mutate(art.cd4=relevel(factor(art.cd4),ref='200')) return(XA) } diff --git a/code/analysis/meta.r b/code/analysis/meta.r index 83df9ea..e2a8644 100644 --- a/code/analysis/meta.r +++ b/code/analysis/meta.r @@ -106,11 +106,11 @@ C = list(# groups of columns C$diff = c(C$diff.dx,C$diff.art.i,C$diff.art.o) P = list(# stuff to plot api = c( - 'api.prev','api.inc','api.phase', - 'art.rbeta','art.cd4','art.cov','art.init', + 'api.prev.cat','api.phase', + 'art.rbeta.cat','art.cd4','art.cov.cat','art.init.cat', 'hiv.x.acute','hiv.x.late','hiv.morb.any','art.tdr','art.fail.any','art.drop.any','bc.any', - 'act.def.sex','Risk','act.n','act.mix','act.turn.any','pt.def','age.n','age.mix', - 'act.HRW.p','act.HRM.p','act.HRW.cr','act.HR.pr' + 'act.def.sex','Risk','act.n.cat','act.mix','act.turn.any','pt.def','age.n.cat','age.mix' + # 'act.HRW.p','act.HRM.p','act.HRW.cr','act.HR.pr' ), dist = c('api.prev','api.inc','art.rbeta','act.n','age.n','hiv.n', 'act.HRW.p','act.HRM.p','act.HRW.cr','act.HR.pr', @@ -199,6 +199,10 @@ R = list(# Rename stuff '500'='500', 'Any'='All', 'Symptomatic'='symp'), + art.cov.cat = list( + '0.0-0.59'='0', + '0.60-0.84'='0.6', + '0.85+'='0.85'), art.rbeta.cat = list( '0.0-0.039'='0', '0.04-0.099'='0.04', diff --git a/code/analysis/plot.r b/code/analysis/plot.r index 9f558d3..6680d62 100644 --- a/code/analysis/plot.r +++ b/code/analysis/plot.r @@ -1,41 +1,42 @@ -plot.api.list = function(XA,drop=FALSE,...){ +plot.api.list = function(XA,...){ args = c(...) if (length(args)){ plot.vars = args } else { plot.vars = P$api } for (which in c('chi','inc')){ XA. = make.api.data(XA,which=which) for (var in plot.vars){ - XA. %>% make.bib.wt %>% - plot.api(which=which,drop=drop,color=var,size='wt') %>% + plot.api(XA.,which=which,geom='box',color=var,fill=var) %>% + save.plot(namefun(which,var),dir='api',width=5,height=4) + plot.api(XA.,which=which,geom='point',color=var) %>% save.plot(namefun(which,'s',var),dir='api',width=5,height=4) - XA. %>% agg.api.data(fun=median,var) %>% - plot.api(which=which,drop=drop,color=var) %>% - save.plot(namefun(which,'a',var),dir='api',width=5,height=4) } } } -plot.api = function(XAi,which='chi',drop=FALSE,...){ +plot.api = function(XAi,which='chi',geom='box',...){ ylabs = list( 'chi' = 'Cumulative HIV Infections Averted', 'inc' = 'Reduction in HIV Incidence' ) - args = list(...) - clr = XAi[[ifelse(is.null(args$color),NA,args$color)]] - s = XAi[[ifelse(is.null(args$size), NA,args$size )]] - size.lims = 4*c(ifelse(length(s),min(s),1),ifelse(length(s),max(s),1)) - clr.args = list(option='inferno',begin=.1,end=.75) - if (!is.numeric(clr)){ clr.args = c(clr.args,list(discrete=TRUE,drop=drop)) } + args = list('t.cat',...) + clr.args = list(option='inferno',begin=.1,end=.75,discrete=TRUE,drop=TRUE) g = XAi %>% rename.lvls(args) %>% - ggplot(aes_string(x='t',y='value',...,size=3)) + + ggplot(aes_string(x=ifelse(geom=='box','t.cat','t'),y='value',...)) + geom_hline(yintercept=0,color='gray') + - geom_point(alpha=.6,position='jitter') + - ylim(-.15, 1) + ylab(ylabs[[which]]) + - xlim( -1, 41) + xlab('Time since Roll-Out (years)') + - scale_size(range=size.lims) + - guides(size=FALSE) + do.call(scale_color_viridis,clr.args) + + do.call(scale_fill_viridis,clr.args) + + labs(y=ylabs[[which]],x='Time since Roll-Out (years)') + + ylim(-.15, 1.05) + theme_light() + theme(legend.title=element_blank(),legend.margin=margin(0,0,0,0)) + if (geom=='box'){ + pos = position_dodge2(width=.8,preserve='single') + g = g + geom_boxplot(alpha=.4,position=pos) + + stat_summary(geom='text',show.legend=FALSE,size=2.5,position=pos, + fun.data=function(y){ data.frame(y=1.03,label=length(y)) }) + } + if (geom=='point'){ + g = g + geom_point(alpha=.6,position='jitter',stroke=0,size=2) + xlim(-1,41) + } return(g) } @@ -65,22 +66,19 @@ plot.distr.list = function(X){ } plot.distr = function(X,var){ - if (is.numeric(X[[var]])){ - geom = geom_histogram - args = list(bins=16,alpha=.4,color='red',fill='red') - } else { - geom = geom_bar - args = list(alpha=.4) - } clr.args = list(option='inferno',discrete=TRUE,begin=.1,end=.85,na.value='gray') g = X %>% rename.lvls(var) %>% ggplot(aes_string(x=var,color=var,fill=var)) + - do.call(geom,args) + do.call(scale_color_viridis,clr.args) + do.call(scale_fill_viridis,clr.args) + ylab('Studies') + xlab(detex(D[[decat(var)]])) + guides(color=FALSE,fill=FALSE) + theme_light() + if (is.numeric(X[[var]])){ + g = g + geom_histogram(bins=16,alpha=.4,color='#BB3754',fill='#BB3754') + } else { + g = g + geom_bar(alpha=.4) + } return(g) }