Checking HIV prevalence trends in WADOH data: 2014-2019

source code: WApopdata repository

Intro

The purpose of this analysis is to run simple descriptive plots for Dx HIV+ prevalence (count) trends by age, race and region, to make sure there are no anomalies in the data, and to get a sense of what these trends look like.

The data were provided by Steven Erly at WADOH, as aggregated counts of persons living with Dx HIV by age group, race and region. The exposure group is MSM, which includes MSM, MSM+IDU, and a CDC imputation of the MSM from NIR/NRR.

To estimate the prevalence rate, the PLWH counts are divided by the estimates of WA MSM (by attributes). Those estimates are based on the Emory Camp Small Area Estimates project, specifically, the county level estimates published in Grey et al., 2016.

For the age and race estimates, we compare the WADOH prevalence estimates to the alternate estimate based on the age and race specific estimates from the Emory group.

(more info on the Emory Camp Small Area Estimation Project here)

Trends in Dx HIV prevalence

Overall

Plot

# have to construct the overall prev for each yr

num_lb <- num_ub <- pop <- prev_lb <- prev_ub <- rep(NA, 6)

for(i in 1:6) {
  df <- eval(parse(text=paste0("msm.pop.totals_20", 13+i, "[['pop.pos']]")))
  num_lb[i] <- sum(df$num_lb)
  num_ub[i] <- sum(df$num_ub)
  pop[i] <- sum(df$popsize)
  prev_lb[i] <- num_lb[i]/pop[i]
  prev_ub[i] <- num_ub[i]/pop[i]
}

prevdf <- data.frame(year = 2014:2019,
                     popsize = pop,
                     num_lb = num_lb,
                     num_ub = num_ub,
                     dxprev_lb = prev_lb,
                     dxprev_ub = prev_ub)

ggplot(prevdf, aes(x=year)) +
  geom_ribbon(aes(ymin = dxprev_lb, ymax = dxprev_ub),
              fill = "blue", alpha = 0.5) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 0.1)) +
  labs(title = "MSM Dx Prevalence: Overall by Year",
       x = "Year", y = "Dx prevalence")

Table

kable(prevdf,
      caption = "Dx Prevalence by Year", 
      digits = c(0,0,0,4,4,4,4)) %>%
  kable_styling(bootstrap_options = c("striped"))

Dx Prevalence by Year

year	popsize	num_lb	num_ub	dxprev_lb	dxprev_ub
2014	122377	8532	8978.9	0.0697	0.0734
2015	124776	8836	9298.4	0.0708	0.0745
2016	127412	9030	9507.8	0.0709	0.0746
2017	130051	9365	9870.9	0.0720	0.0759
2018	132319	9585	10113.9	0.0724	0.0764
2019	134314	9729	10282.4	0.0724	0.0766

By age

Plot

ltyp = c("2013" = "dotted")
ggplot(data=msm.pop.totals_2014$pop.age.pos,
       aes(x=age.grp10, y=dx.prev_ub, group=1)) +
  theme_bw() +
  scale_y_continuous(labels = scales::percent_format(accuracy = 0.1)) +
  geom_line(aes(color="2014"), lwd = 0.75) +
  geom_line(data=msm.pop.totals_2015$pop.age.pos,
            aes(x=age.grp10, y=dx.prev_ub,
                group=1, color="2015"), lwd = 0.75) +
  geom_line(data=msm.pop.totals_2016$pop.age.pos,
            aes(x=age.grp10, y=dx.prev_ub,
                group=1, color="2016"), lwd = 0.75) +
  geom_line(data=msm.pop.totals_2017$pop.age.pos,
            aes(x=age.grp10, y=dx.prev_ub,
                group=1, color="2017"), lwd = 0.75) +
  geom_line(data=msm.pop.totals_2018$pop.age.pos,
            aes(x=age.grp10, y=dx.prev_ub,
                group=1, color="2018"), lwd = 0.75) +
  geom_line(data=msm.pop.totals_2019$pop.age.pos,
            aes(x=age.grp10, y=dx.prev_ub,
                group=1, color="2019"), lwd = 0.75) +
  geom_line(data=msm.pop.totals_2014$pop.age.pos,
            aes(x=age.grp10, y=dx.prev_ub_alt,
                group=1, linetype="2013"), color="black", lwd=1) +
  labs(title = "MSM Dx HIV prevalence by age and year",
       caption = "Jones Est from Emory group, Jones et al., 2018, for 2013 WA prevalence") +
  scale_linetype_manual(name = "Jones Est", values = ltyp) +
  guides(color = guide_legend(order = 1),
         linetype = guide_legend(order = 2)) +
  scale_color_brewer(name ="Year")

Tables

kable(msm.pop.totals_2014$pop.age.pos,
      caption = "2014", 
      digits = c(0,0,0,4,4,4,4)) %>%
  kable_styling(bootstrap_options = c("striped"))

2014

age.grp10	num_lb	num_ub	popsize	popsize.alt	dx.prev_lb	dx.prev_ub	dx.prev_lb_alt	dx.prev_ub_alt
15-24	124	127	19989.398	23357	0.0062	0.0063	0	0
25-34	1070	1118	23734.311	29689	0.0451	0.0471	0	0
35-44	1697	1809	21372.966	29181	0.0794	0.0847	0	0
45-54	3133	3283	21098.764	30242	0.1485	0.1556	0	0
55-64	1907	1993	18688.789	10485	0.1020	0.1066	0	0
65-74	527	569	10931.276	7192	0.0482	0.0520	0	0
75-84	70	75	4728.787	3099	0.0148	0.0159	0	0
85+	4	4	1832.522	1068	0.0022	0.0023	0	0

kable(msm.pop.totals_2015$pop.age.pos,
      caption = "2015", 
      digits = c(0,0,0,4,4,4,4)) %>%
  kable_styling(bootstrap_options = c("striped"))

2015

age.grp10	num_lb	num_ub	popsize	popsize.alt	dx.prev_lb	dx.prev_ub	dx.prev_lb_alt	dx.prev_ub_alt
15-24	115	118	20023.049	23357	0.0057	0.0059	0	0
25-34	1117	1173	24627.164	29689	0.0454	0.0476	0	0
35-44	1707	1814	21580.443	29181	0.0791	0.0841	0	0
45-54	3102	3259	21173.885	30242	0.1465	0.1539	0	0
55-64	2112	2202	19052.355	10485	0.1109	0.1156	0	0
65-74	599	641	11569.157	7192	0.0518	0.0554	0	0
75-84	78	85	4872.014	3099	0.0160	0.0175	0	0
85+	6	6	1878.133	1068	0.0032	0.0033	0	0

kable(msm.pop.totals_2016$pop.age.pos,
      caption = "2016", 
      digits = c(0,0,0,4,4,4,4)) %>%
  kable_styling(bootstrap_options = c("striped"))

2016

age.grp10	num_lb	num_ub	popsize	popsize.alt	dx.prev_lb	dx.prev_ub	dx.prev_lb_alt	dx.prev_ub_alt
15-24	116	121	20009.334	23357	0.0058	0.0060	0	0
25-34	1151	1200	25637.992	29689	0.0449	0.0468	0	0
35-44	1709	1816	21918.313	29181	0.0780	0.0828	0	0
45-54	2970	3128	21284.008	30242	0.1395	0.1470	0	0
55-64	2290	2397	19421.081	10485	0.1179	0.1234	0	0
65-74	691	733	12172.620	7192	0.0568	0.0602	0	0
75-84	101	111	5041.358	3099	0.0200	0.0220	0	0
85+	2	2	1927.287	1068	0.0010	0.0011	0	0

kable(msm.pop.totals_2017$pop.age.pos,
      caption = "2017", 
      digits = c(0,0,0,4,4,4,4)) %>%
  kable_styling(bootstrap_options = c("striped"))

2017

age.grp10	num_lb	num_ub	popsize	popsize.alt	dx.prev_lb	dx.prev_ub	dx.prev_lb_alt	dx.prev_ub_alt
15-24	115	122	19983.451	23357	0.0058	0.0061	0	0
25-34	1236	1285	26677.885	29689	0.0463	0.0482	0	0
35-44	1747	1852	22431.269	29181	0.0779	0.0826	0	0
45-54	2854	3020	21301.766	30242	0.1340	0.1418	0	0
55-64	2491	2614	19714.834	10485	0.1264	0.1326	0	0
65-74	797	845	12723.254	7192	0.0626	0.0664	0	0
75-84	121	130	5258.062	3099	0.0230	0.0247	0	0
85+	4	4	1960.236	1068	0.0020	0.0021	0	0

kable(msm.pop.totals_2018$pop.age.pos,
      caption = "2018", 
      digits = c(0,0,0,4,4,4,4)) %>%
  kable_styling(bootstrap_options = c("striped"))

2018

age.grp10	num_lb	num_ub	popsize	popsize.alt	dx.prev_lb	dx.prev_ub	dx.prev_lb_alt	dx.prev_ub_alt
15-24	111	115	19946.957	23357	0.0056	0.0058	0	0
25-34	1238	1292	27522.330	29689	0.0450	0.0470	0	0
35-44	1818	1925	23051.494	29181	0.0789	0.0835	0	0
45-54	2698	2870	21163.467	30242	0.1275	0.1356	0	0
55-64	2693	2825	19879.971	10485	0.1355	0.1421	0	0
65-74	885	934	13206.069	7192	0.0670	0.0707	0	0
75-84	138	149	5556.904	3099	0.0248	0.0268	0	0
85+	4	4	1992.172	1068	0.0020	0.0021	0	0

kable(msm.pop.totals_2019$pop.age.pos,
      caption = "2019", 
      digits = c(0,0,0,4,4,4,4)) %>%
  kable_styling(bootstrap_options = c("striped"))

2019

age.grp10	num_lb	num_ub	popsize	popsize.alt	dx.prev_lb	dx.prev_ub	dx.prev_lb_alt	dx.prev_ub_alt
15-24	103	110	19985.182	23357	0.0052	0.0055	0	0
25-34	1290	1358	28165.572	29689	0.0458	0.0482	0	0
35-44	1833	1934	23675.963	29181	0.0774	0.0817	0	0
45-54	2545	2716	20968.773	30242	0.1214	0.1295	0	0
55-64	2807	2944	19928.890	10485	0.1409	0.1477	0	0
65-74	988	1047	13669.169	7192	0.0723	0.0766	0	0
75-84	155	165	5889.662	3099	0.0263	0.0280	0	0
85+	8	10	2030.338	1068	0.0039	0.0049	0	0

By race

Plot

Tables

kable(msm.pop.totals_2014$pop.race.pos,
      caption = "2014", 
      digits = c(0,0,0,4,4,4,4)) %>%
  kable_styling(bootstrap_options = c("striped"))

2014

race	num_lb	num_ub	popsize	popsize.alt	dx.prev_lb	dx.prev_ub	dx.prev_lb_alt	dx.prev_ub_alt
B	685	753	6976.658	8475	0.0982	0.1079	0	0
H	1083	1184	11189.788	12123	0.0968	0.1058	0	0
O	6764	7042	104210.368	113715	0.0649	0.0676	0	0

kable(msm.pop.totals_2015$pop.race.pos,
      caption = "2015", 
      digits = c(0,0,0,4,4,4,4)) %>%
  kable_styling(bootstrap_options = c("striped"))

2015

race	num_lb	num_ub	popsize	popsize.alt	dx.prev_lb	dx.prev_ub	dx.prev_lb_alt	dx.prev_ub_alt
B	717	788	7209.325	8475	0.0995	0.1093	0	0
H	1179	1282	11576.288	12123	0.1018	0.1108	0	0
O	6940	7228	105990.588	113715	0.0655	0.0682	0	0

kable(msm.pop.totals_2016$pop.race.pos,
      caption = "2016", 
      digits = c(0,0,0,4,4,4,4)) %>%
  kable_styling(bootstrap_options = c("striped"))

2016

race	num_lb	num_ub	popsize	popsize.alt	dx.prev_lb	dx.prev_ub	dx.prev_lb_alt	dx.prev_ub_alt
B	748	819	7476.28	8475	0.1000	0.1096	0	0
H	1249	1350	12030.55	12123	0.1038	0.1122	0	0
O	7033	7338	107905.16	113715	0.0652	0.0680	0	0

kable(msm.pop.totals_2017$pop.race.pos,
      caption = "2017", 
      digits = c(0,0,0,4,4,4,4)) %>%
  kable_styling(bootstrap_options = c("striped"))

2017

race	num_lb	num_ub	popsize	popsize.alt	dx.prev_lb	dx.prev_ub	dx.prev_lb_alt	dx.prev_ub_alt
B	808	885	7774.016	8475	0.1039	0.1138	0	0
H	1358	1464	12523.051	12123	0.1084	0.1169	0	0
O	7199	7522	109753.690	113715	0.0656	0.0685	0	0

kable(msm.pop.totals_2018$pop.race.pos,
      caption = "2018", 
      digits = c(0,0,0,4,4,4,4)) %>%
  kable_styling(bootstrap_options = c("striped"))

2018

race	num_lb	num_ub	popsize	popsize.alt	dx.prev_lb	dx.prev_ub	dx.prev_lb_alt	dx.prev_ub_alt
B	852	935	8064.546	8475	0.1056	0.1159	0	0
H	1430	1539	12964.405	12123	0.1103	0.1187	0	0
O	7303	7640	111290.415	113715	0.0656	0.0686	0	0

kable(msm.pop.totals_2019$pop.race.pos,
      caption = "2019", 
      digits = c(0,0,0,4,4,4,4)) %>%
  kable_styling(bootstrap_options = c("striped"))

2019

race	num_lb	num_ub	popsize	popsize.alt	dx.prev_lb	dx.prev_ub	dx.prev_lb_alt	dx.prev_ub_alt
B	890	978	8353.172	8475	0.1065	0.1170	0	0
H	1505	1625	13397.066	12123	0.1123	0.1213	0	0
O	7334	7680	112563.311	113715	0.0652	0.0682	0	0

By region

Plot

ggplot(data=msm.pop.totals_2014$pop.region.pos,
       aes(x=region, y=dx.prev_ub, group=1)) +
  theme_bw() +
  scale_y_continuous(labels = scales::percent_format(accuracy = 0.1)) +
  geom_line(aes(color="2014"), lwd = 0.75) +
  geom_line(data=msm.pop.totals_2015$pop.region.pos,
            aes(x=region, y=dx.prev_ub,
                group=1, color="2015"), lwd = 0.75) +
  geom_line(data=msm.pop.totals_2016$pop.region.pos,
            aes(x=region, y=dx.prev_ub,
                group=1, color="2016"), lwd = 0.75) +
  geom_line(data=msm.pop.totals_2017$pop.region.pos,
            aes(x=region, y=dx.prev_ub,
                group=1, color="2017"), lwd = 0.75) +
  geom_line(data=msm.pop.totals_2018$pop.region.pos,
            aes(x=region, y=dx.prev_ub,
                group=1, color="2018"), lwd = 0.75) +
  geom_line(data=msm.pop.totals_2019$pop.region.pos,
            aes(x=region, y=dx.prev_ub,
                group=1, color="2019"), lwd = 0.75) +
  labs(title = "MSM Dx HIV prevalence by region and year") +
  scale_color_brewer(name ="Year")

Tables

kable(msm.pop.totals_2014$pop.region.pos,
      caption = "2014", 
      digits = c(0,0,0,4,4,4,4)) %>%
  kable_styling(bootstrap_options = c("striped"))

2014

region	num_lb	num_ub	popsize	dx.prev_lb	dx.prev_ub
EasternWA	941	1009	12818.29	0.0734	0.0787
King	5120	5307	67731.48	0.0756	0.0784
WesternWA	2471	2662	41827.04	0.0591	0.0637

kable(msm.pop.totals_2015$pop.region.pos,
      caption = "2015", 
      digits = c(0,0,0,4,4,4,4)) %>%
  kable_styling(bootstrap_options = c("striped"))

2015

region	num_lb	num_ub	popsize	dx.prev_lb	dx.prev_ub
EasternWA	1046	1120	12972.25	0.0806	0.0863
King	5205	5393	69265.32	0.0751	0.0779
WesternWA	2585	2786	42538.64	0.0608	0.0655

kable(msm.pop.totals_2016$pop.region.pos,
      caption = "2016", 
      digits = c(0,0,0,4,4,4,4)) %>%
  kable_styling(bootstrap_options = c("striped"))

2016

region	num_lb	num_ub	popsize	dx.prev_lb	dx.prev_ub
EasternWA	1084	1164	13159.29	0.0824	0.0885
King	5253	5441	70869.17	0.0741	0.0768
WesternWA	2693	2902	43383.53	0.0621	0.0669

kable(msm.pop.totals_2017$pop.region.pos,
      caption = "2017", 
      digits = c(0,0,0,4,4,4,4)) %>%
  kable_styling(bootstrap_options = c("striped"))

2017

region	num_lb	num_ub	popsize	dx.prev_lb	dx.prev_ub
EasternWA	1157	1244	13361.95	0.0866	0.0931
King	5319	5512	72381.63	0.0735	0.0762
WesternWA	2889	3115	44307.17	0.0652	0.0703

kable(msm.pop.totals_2018$pop.region.pos,
      caption = "2018", 
      digits = c(0,0,0,4,4,4,4)) %>%
  kable_styling(bootstrap_options = c("striped"))

2018

region	num_lb	num_ub	popsize	dx.prev_lb	dx.prev_ub
EasternWA	1198	1292	13561.63	0.0883	0.0953
King	5344	5550	73638.01	0.0726	0.0754
WesternWA	3043	3272	45119.72	0.0674	0.0725

kable(msm.pop.totals_2019$pop.region.pos,
      caption = "2019", 
      digits = c(0,0,0,4,4,4,4)) %>%
  kable_styling(bootstrap_options = c("striped"))

2019

region	num_lb	num_ub	popsize	dx.prev_lb	dx.prev_ub
EasternWA	1251	1357	13750.88	0.0910	0.0987
King	5351	5561	74721.85	0.0716	0.0744
WesternWA	3127	3365	45840.82	0.0682	0.0734