Checking new Dx rate trends in WADOH data: 2014-2019

source code: WApopdata repository

Intro

The purpose of this analysis is to run simple descriptive plots for new Dx HIV+ (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 new 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 new Dx 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 rate 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 new Dx HIV

Overall

Plot

# have to construct the overall prev for each yr

num_lb <- num_ub <- pop <- inci_lb <- inci_ub <- rep(NA, 6)

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

incidf <- data.frame(year = 2014:2019,
                     popsize = pop,
                     num_lb = num_lb,
                     num_ub = num_ub,
                     dxinci_lb = inci_lb,
                     dxinci_ub = inci_ub)

ggplot(incidf, aes(x=year)) +
  geom_ribbon(aes(ymin = dxinci_lb, ymax = dxinci_ub),
              fill = "blue", alpha = 0.5) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 0.01)) +
  labs(title = "Dx incidence: Overall by Year",
       x = "Year", y = "Dx incidence")

Table

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

Dx Incidence by Year

year	popsize	num_lb	num_ub	dxinci_lb	dxinci_ub
2014	122377	257	284.3	0.0021	0.0023
2015	124776	281	306.6	0.0023	0.0025
2016	127412	224	258.3	0.0018	0.0020
2017	130051	241	272.2	0.0019	0.0021
2018	132319	242	269.9	0.0018	0.0020
2019	134314	270	298.8	0.0020	0.0022

By age

Plot

ltyp = c("2013" = "dotted")
ggplot(data=msm.pop.totals_2014$newdx.age,
       aes(x=age.grp10, y=dx.inci_ub, group=1)) +
  theme_bw() +
  scale_y_continuous(labels = scales::percent_format(accuracy = 0.01)) +
  geom_line(aes(color="2014"), lwd = .75) +
  geom_line(data=msm.pop.totals_2015$newdx.age,
            aes(x=age.grp10, y=dx.inci_ub,
                group=1, color="2015"), lwd = .75) +
  geom_line(data=msm.pop.totals_2016$newdx.age,
            aes(x=age.grp10, y=dx.inci_ub,
                group=1, color="2016"), lwd = .75) +
  geom_line(data=msm.pop.totals_2017$newdx.age,
            aes(x=age.grp10, y=dx.inci_ub,
                group=1, color="2017"), lwd = .75) +
  geom_line(data=msm.pop.totals_2018$newdx.age,
            aes(x=age.grp10, y=dx.inci_ub,
                group=1, color="2018"), lwd = .75) +
  geom_line(data=msm.pop.totals_2019$newdx.age,
            aes(x=age.grp10, y=dx.inci_ub,
                group=1, color="2019"), lwd = .75) +
  geom_line(data=msm.pop.totals_2014$newdx.age,
            aes(x=age.grp10, y=dx.inci_ub_alt,
                group=1, linetype="2013"), color="black", lwd=1) +
  labs(title = "MSM new Dx rate by age and year",
       caption = "Jones Est from Emory group, Jones et al., 2018, for 2013 WA rate",
       x = "age", y = "percent") +
  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$newdx.age,
      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.inci_lb	dx.inci_ub	dx.inci_lb_alt	dx.inci_ub_alt
15-24	39	39	19989.398	23357	0.0020	0.0020	0	0
25-34	91	96	23734.311	29689	0.0038	0.0040	0	0
35-44	56	66	21372.966	29181	0.0026	0.0031	0	0
45-54	50	58	21098.764	30242	0.0024	0.0028	0	0
55-64	14	17	18688.789	10485	0.0007	0.0009	0	0
65-74	6	8	10931.276	7192	0.0005	0.0007	0	0
75-84	1	1	4728.787	3099	0.0002	0.0002	0	0
85+	0	0	1832.522	1068	0.0000	0.0000	0	0

kable(msm.pop.totals_2015$newdx.age,
      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.inci_lb	dx.inci_ub	dx.inci_lb_alt	dx.inci_ub_alt
15-24	35	35	20023.049	23357	0.0017	0.0017	0	0
25-34	116	128	24627.164	29689	0.0047	0.0052	0	0
35-44	59	65	21580.443	29181	0.0027	0.0030	0	0
45-54	51	54	21173.885	30242	0.0024	0.0026	0	0
55-64	18	22	19052.355	10485	0.0009	0.0012	0	0
65-74	1	1	11569.157	7192	0.0001	0.0001	0	0
75-84	1	1	4872.014	3099	0.0002	0.0003	0	0
85+	0	0	1878.133	1068	0.0000	0.0000	0	0

kable(msm.pop.totals_2016$newdx.age,
      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.inci_lb	dx.inci_ub	dx.inci_lb_alt	dx.inci_ub_alt
15-24	34	36	20009.334	23357	0.0017	0.0018	0	0
25-34	84	89	25637.992	29689	0.0033	0.0035	0	0
35-44	48	57	21918.313	29181	0.0022	0.0026	0	0
45-54	33	43	21284.008	30242	0.0016	0.0020	0	0
55-64	16	22	19421.081	10485	0.0008	0.0011	0	0
65-74	7	8	12172.620	7192	0.0006	0.0007	0	0
75-84	2	3	5041.358	3099	0.0004	0.0006	0	0
85+	0	0	1927.287	1068	0.0000	0.0000	0	0

kable(msm.pop.totals_2017$newdx.age,
      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.inci_lb	dx.inci_ub	dx.inci_lb_alt	dx.inci_ub_alt
15-24	24	24	19983.451	23357	0.0012	0.0012	0	0
25-34	116	122	26677.885	29689	0.0043	0.0046	0	0
35-44	41	50	22431.269	29181	0.0018	0.0022	0	0
45-54	41	48	21301.766	30242	0.0019	0.0022	0	0
55-64	18	24	19714.834	10485	0.0009	0.0012	0	0
65-74	0	4	12723.254	7192	0.0000	0.0003	0	0
75-84	1	1	5258.062	3099	0.0002	0.0002	0	0
85+	0	0	1960.236	1068	0.0000	0.0000	0	0

kable(msm.pop.totals_2018$newdx.age,
      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.inci_lb	dx.inci_ub	dx.inci_lb_alt	dx.inci_ub_alt
15-24	29	30	19946.957	23357	0.0015	0.0015	0	0
25-34	99	106	27522.330	29689	0.0036	0.0038	0	0
35-44	66	73	23051.494	29181	0.0029	0.0032	0	0
45-54	27	35	21163.467	30242	0.0013	0.0016	0	0
55-64	17	22	19879.971	10485	0.0009	0.0011	0	0
65-74	4	5	13206.069	7192	0.0003	0.0004	0	0
75-84	0	0	5556.904	3099	0.0000	0.0000	0	0
85+	0	0	1992.172	1068	0.0000	0.0000	0	0

kable(msm.pop.totals_2019$newdx.age,
      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.inci_lb	dx.inci_ub	dx.inci_lb_alt	dx.inci_ub_alt
15-24	36	40	19985.182	23357	0.0018	0.0020	0	0
25-34	125	140	28165.572	29689	0.0044	0.0050	0	0
35-44	51	53	23675.963	29181	0.0022	0.0022	0	0
45-54	34	37	20968.773	30242	0.0016	0.0018	0	0
55-64	16	20	19928.890	10485	0.0008	0.0010	0	0
65-74	6	8	13669.169	7192	0.0004	0.0006	0	0
75-84	1	1	5889.662	3099	0.0002	0.0001	0	0
85+	1	1	2030.338	1068	0.0005	0.0005	0	0

By race

Plot

Tables

kable(msm.pop.totals_2014$newdx.race,
      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.inci_lb	dx.inci_ub	dx.inci_lb_alt	dx.inci_ub_alt
B	24	29	6976.658	8475	0.0034	0.0041	0	0
H	37	42	11189.788	12123	0.0033	0.0037	0	0
O	196	214	104210.368	113715	0.0019	0.0021	0	0

kable(msm.pop.totals_2015$newdx.race,
      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.inci_lb	dx.inci_ub	dx.inci_lb_alt	dx.inci_ub_alt
B	33	36	7209.325	8475	0.0046	0.0050	0	0
H	64	72	11576.288	12123	0.0055	0.0063	0	0
O	184	198	105990.588	113715	0.0017	0.0019	0	0

kable(msm.pop.totals_2016$newdx.race,
      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.inci_lb	dx.inci_ub	dx.inci_lb_alt	dx.inci_ub_alt
B	24	28	7476.28	8475	0.0032	0.0037	0	0
H	42	48	12030.55	12123	0.0035	0.0040	0	0
O	158	183	107905.16	113715	0.0015	0.0017	0	0

kable(msm.pop.totals_2017$newdx.race,
      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.inci_lb	dx.inci_ub	dx.inci_lb_alt	dx.inci_ub_alt
B	28	34	7774.016	8475	0.0036	0.0044	0	0
H	56	62	12523.051	12123	0.0045	0.0050	0	0
O	157	176	109753.690	113715	0.0014	0.0016	0	0

kable(msm.pop.totals_2018$newdx.race,
      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.inci_lb	dx.inci_ub	dx.inci_lb_alt	dx.inci_ub_alt
B	28	33	8064.546	8475	0.0035	0.0041	0	0
H	49	55	12964.405	12123	0.0038	0.0042	0	0
O	165	183	111290.415	113715	0.0015	0.0016	0	0

kable(msm.pop.totals_2019$newdx.race,
      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.inci_lb	dx.inci_ub	dx.inci_lb_alt	dx.inci_ub_alt
B	28	30	8353.172	8475	0.0034	0.0037	0	0
H	78	86	13397.066	12123	0.0058	0.0064	0	0
O	164	182	112563.311	113715	0.0015	0.0016	0	0

By region

Plot

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

Tables

kable(msm.pop.totals_2014$newdx.region,
      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.inci_lb	dx.inci_ub
EasternWA	21	23	12818.29	0.0016	0.0018
King	168	180	67731.48	0.0025	0.0027
WesternWA	68	81	41827.04	0.0016	0.0019

kable(msm.pop.totals_2015$newdx.region,
      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.inci_lb	dx.inci_ub
EasternWA	29	35	12972.25	0.0022	0.0027
King	155	164	69265.32	0.0022	0.0024
WesternWA	97	107	42538.64	0.0023	0.0025

kable(msm.pop.totals_2016$newdx.region,
      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.inci_lb	dx.inci_ub
EasternWA	28	41	13159.29	0.0021	0.0031
King	128	136	70869.17	0.0018	0.0019
WesternWA	68	82	43383.53	0.0016	0.0019

kable(msm.pop.totals_2017$newdx.region,
      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.inci_lb	dx.inci_ub
EasternWA	44	49	13361.95	0.0033	0.0037
King	124	133	72381.63	0.0017	0.0018
WesternWA	73	90	44307.17	0.0016	0.0020

kable(msm.pop.totals_2018$newdx.region,
      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.inci_lb	dx.inci_ub
EasternWA	31	39	13561.63	0.0023	0.0029
King	137	150	73638.01	0.0019	0.0020
WesternWA	74	81	45119.72	0.0016	0.0018

kable(msm.pop.totals_2019$newdx.region,
      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.inci_lb	dx.inci_ub
EasternWA	51	59	13750.88	0.0037	0.0043
King	134	142	74721.85	0.0018	0.0019
WesternWA	85	98	45840.82	0.0019	0.0021