WHAMP Partner Distributions

rm(list = ls())

library(dplyr)
library(ggplot2)
library(ggpubr)
library(plotly)
library(kableExtra)

Back to Outline

Introduction

This report presents descriptive statistics for the sexual partnerships used to drive the dynamic sexual network model. The data used here come from the WHAMP Survey supplemented by the ARTnet WA cases (927 and 168 cases respectively).

Partnership data was collected in both summary form, as the total number of anal sex partners in the last year, and in detail for the most recent 5 partners in the last year. In the detailed partner modules respondents were asked to classify partners as “main”, “casual”, or “onetime” partners, and for the main and casual partners whether they are active (ongoing) on the day of interview.

Distributions of partner counts derived from these data are used for validation targets for the EpiModel simulations.

• The “Active partnerships” section covers main and casual partnerships that are active on the day of interview, summarized as “degree distributions”, and counts of the number of onetime partners per week.

• The “Mean degree” section also reports on active partnerships, summarizing the degree distribution by the mean.

• The “Cumulative partnerships” section covers the total number of partners reported in the last year, overall and by partner type.

---

Data

egodat <- WHAMPData::whampArtnetWA_egodata
egos <- egodat$main$egos %>%
  mutate(count.oo.wk = round(count.oo.part/52))

Indicator construction

For active partnerships:

• Total active = active main + active casual – these are the only partnerships with persistence, and the only ones that could be “active” on the day of interview

• Onetime partners – the most comparable indicator is the number of onetime partners per week (the timestep in the simulation). We discuss how we constructed this indicator in that section.

For cumulative partner counts:

• The total cumulative is based on the summary number of partners reported in the last year.

• The classification of anal sex partners into main/casual/onetime is only available for the partners reported in the detailed modules, so we use the number of main or casual partners in the modules as the annual total for each of those types, and the cumulative total onetime partners are calculated by subtraction of the sum (main + casual) from the total.

This will result in some level of misclassification, as we are assuming that all partners beyond the 5 reported in the detailed modules are onetime partners.

• The impact is limited to the 28% of respondents who reported 6+ partners in the last year.

• It is unlikely to impact the annual count of main partners; only 7% of the more than a single main partner in the last year, and the maximum reported was 2.

• The primary impact is likely to be the misclassification of casual partners as onetime partners in the annual counts. We do have summary questions for the number of main and onetime partners for those reporting 6+ partners, but we can not identify which of these are anal sex partners. The impact is likely to be small, but it is in the tail, and casual partnerships, because they are persistent, have higher transmission risks. See this issue on GitHub

Missingness

Missing values in the demographic breakdown variables are minimal.

Missing values for estimating the degree distributions come primarily from survey attrition (156 cases in WHAMP, 16.8%) and reporting no anal sex since 2010 (89 cases in WHAMP, 18 cases in ARTnetWA, 11.5% and 10.7% respectively).

---

Active Partnerships (degree)

Total

• Sum of main and casual partners active on the day of interview.

Overall

tot.deg <- egos %>%
  group_by(deg.tot) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

Plot

p <- ggplot(tot.deg, aes(x=factor(deg.tot), y=prop.wtd, 
            text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(fill = "blue", alpha = 0.5, stat = "identity") +
  labs(title = "Total active partnerships (main + casl)",
       x = "degree",
       y = "wtd proportion")

ggplotly(p, tooltip = "text")

Table

tot.deg %>% kable(caption= "Total degree") %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Total degree

deg.tot	nobs	n.wtd	prop.wtd
0	250	252.2	0.30
1	359	349.6	0.42
2	100	98.1	0.12
3	74	79.4	0.10
4	38	39.1	0.05
5	11	13.5	0.02

Age

tempDF <- egos %>%
  group_by(deg.tot, age.grp) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  group_by(age.grp) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

age.deg <- tempDF

Plot

p <- ggplot(tempDF, 
            aes(x=factor(deg.tot), y=prop.wtd,
                group = age.grp, fill = factor(age.grp),
                text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(alpha = 0.7, stat = "identity", position = "dodge") +
  labs(title = "Total active partnerships (main + casl)",
       x = "degree",
       y = "wtd proportion",
       fill = "age group") +
  scale_fill_brewer() +
  theme_bw()

ggplotly(p, tooltip = "text")

Table

sjPlot::tab_xtab(var.row = egos$deg.tot, 
                 var.col = egos$age.grp, 
                 weight.by = egos$ego.wawt,
                 title = "Total degree by age group",
                 show.col.prc = T,
                 show.summary = F)

Total degree by age group

deg.tot	age.grp					Total
	1	2	3	4	5
0	67 46.5 %	64 30.3 %	40 22.5 %	42 27.3 %	39 26.5 %	252 30.2 %
1	68 47.2 %	90 42.7 %	78 43.8 %	66 42.9 %	49 33.3 %	351 42.1 %
2	3 2.1 %	33 15.6 %	24 13.5 %	16 10.4 %	22 15 %	98 11.8 %
3	4 2.8 %	19 9 %	19 10.7 %	19 12.3 %	19 12.9 %	80 9.6 %
4	2 1.4 %	5 2.4 %	9 5.1 %	8 5.2 %	15 10.2 %	39 4.7 %
5	0 0 %	0 0 %	8 4.5 %	3 1.9 %	3 2 %	14 1.7 %
Total	144 100 %	211 100 %	178 100 %	154 100 %	147 100 %	834 100 %

---

Race

tempDF <- egos %>%
  group_by(deg.tot, race) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  group_by(race) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

race.deg <- tempDF

Plot

p <- ggplot(tempDF, 
            aes(x=factor(deg.tot), y=prop.wtd, 
                group = race, fill = factor(race),
                text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(alpha = 0.7, 
           stat = "identity", 
           position = "dodge") +
  labs(title = "Total active partnerships (main + casl)",
       x = "degree",
       y = "wtd proportion",
       fill = "race") 

ggplotly(p, tooltip = "text")

Table

sjPlot::tab_xtab(var.row = egos$deg.tot, 
                 var.col = egos$race, 
                 weight.by = egos$ego.wawt,
                 title = "Total degree by age group",
                 show.col.prc = T,
                 show.summary = F)

Total degree by age group

deg.tot	race			Total
	B	H	O
0	22 39.3 %	33 35.5 %	198 28.9 %	253 30.4 %
1	8 14.3 %	34 36.6 %	307 44.9 %	349 41.9 %
2	6 10.7 %	8 8.6 %	84 12.3 %	98 11.8 %
3	12 21.4 %	10 10.8 %	58 8.5 %	80 9.6 %
4	3 5.4 %	7 7.5 %	29 4.2 %	39 4.7 %
5	5 8.9 %	1 1.1 %	8 1.2 %	14 1.7 %
Total	56 100 %	93 100 %	684 100 %	833 100 %

---

Region

tempDF <- egos %>%
  group_by(deg.tot, region) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  group_by(region) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

region.deg <- tempDF

Plot

p <- ggplot(tempDF, 
            aes(x=factor(deg.tot), y=prop.wtd, 
                group = region, fill = factor(region),
                text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(alpha = 0.7, 
           stat = "identity", 
           position = "dodge") +
  labs(title = "Total active partnerships (main + casl)",
       x = "degree",
       y = "wtd proportion",
       fill = "region") 

ggplotly(p, tooltip = "text")

Table

sjPlot::tab_xtab(var.row = egos$deg.tot, 
                 var.col = egos$region, 
                 weight.by = egos$ego.wawt,
                 title = "Total degree by region",
                 show.col.prc = T,
                 show.summary = F)

Total degree by region

deg.tot	region			Total
	EasternWA	King	WesternWA
0	32 39 %	135 28.7 %	85 30.6 %	252 30.3 %
1	31 37.8 %	201 42.7 %	117 42.1 %	349 42 %
2	9 11 %	66 14 %	23 8.3 %	98 11.8 %
3	8 9.8 %	45 9.6 %	26 9.4 %	79 9.5 %
4	1 1.2 %	20 4.2 %	18 6.5 %	39 4.7 %
5	1 1.2 %	4 0.8 %	9 3.2 %	14 1.7 %
Total	82 100 %	471 100 %	278 100 %	831 100 %

totdeg <- list(all = tot.deg,
               age = age.deg,
               race = race.deg,
               region = region.deg)

---

Main

Overall

main.deg <- egos %>%
  group_by(deg.main) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

Plot

p <- ggplot(main.deg, aes(x=factor(deg.main), y=prop.wtd, 
            text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(fill = "blue", alpha = 0.5, stat = "identity") +
  labs(title = "Main active partnerships",
       x = "degree",
       y = "wtd proportion") 

ggplotly(p, tooltip = "text")

Table

main.deg %>% kable(caption= "Main degree") %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Main degree

deg.main	nobs	n.wtd	prop.wtd
0	609	613.9	0.74
1	206	198.7	0.24
2	16	18.3	0.02
3	1	1.1	0.00

Age

tempDF <- egos %>%
  group_by(deg.main, age.grp) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  group_by(age.grp) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

age.deg <- tempDF

Plot

p <- ggplot(tempDF, 
            aes(x=factor(deg.main), y=prop.wtd,
                group = age.grp, fill = factor(age.grp),
                text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(alpha = 0.7, stat = "identity", position = "dodge") +
  labs(title = "Main active partnerships",
       x = "degree",
       y = "wtd proportion",
       fill = "age group") +
  scale_fill_brewer() +
  theme_bw()

ggplotly(p, tooltip = "text")

Table

sjPlot::tab_xtab(var.row = egos$deg.main, 
                 var.col = egos$age.grp, 
                 weight.by = egos$ego.wawt,
                 title = "Main degree by age group",
                 show.col.prc = T,
                 show.summary = F)

Main degree by age group

deg.main	age.grp					Total
	1	2	3	4	5
0	102 71.3 %	132 62.3 %	132 74.6 %	126 82.4 %	122 83 %	614 73.8 %
1	41 28.7 %	76 35.8 %	36 20.3 %	24 15.7 %	22 15 %	199 23.9 %
2	0 0 %	4 1.9 %	8 4.5 %	3 2 %	3 2 %	18 2.2 %
3	0 0 %	0 0 %	1 0.6 %	0 0 %	0 0 %	1 0.1 %
Total	143 100 %	212 100 %	177 100 %	153 100 %	147 100 %	832 100 %

---

Race

tempDF <- egos %>%
  group_by(deg.main, race) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  group_by(race) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

race.deg <- tempDF

Plot

p <- ggplot(tempDF, 
            aes(x=factor(deg.main), y=prop.wtd, 
                group = race, fill = factor(race),
                text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(alpha = 0.7, 
           stat = "identity", 
           position = "dodge") +
  labs(title = "Main active partnerships",
       x = "degree",
       y = "wtd proportion",
       fill = "race") 

ggplotly(p, tooltip = "text")

Table

sjPlot::tab_xtab(var.row = egos$deg.main, 
                 var.col = egos$race, 
                 weight.by = egos$ego.wawt,
                 title = "Main degree by age group",
                 show.col.prc = T,
                 show.summary = F)

Main degree by age group

deg.main	race			Total
	B	H	O
0	44 78.6 %	71 76.3 %	498 72.9 %	613 73.7 %
1	10 17.9 %	14 15.1 %	175 25.6 %	199 23.9 %
2	2 3.6 %	8 8.6 %	9 1.3 %	19 2.3 %
3	0 0 %	0 0 %	1 0.1 %	1 0.1 %
Total	56 100 %	93 100 %	683 100 %	832 100 %

---

Region

tempDF <- egos %>%
  group_by(deg.main, region) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  group_by(region) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

region.deg <- tempDF

Plot

p <- ggplot(tempDF, 
            aes(x=factor(deg.main), y=prop.wtd, 
                group = region, fill = factor(region),
                text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(alpha = 0.7, 
           stat = "identity", 
           position = "dodge") +
  labs(title = "Main active partnerships",
       x = "degree",
       y = "wtd proportion",
       fill = "region")

ggplotly(p, tooltip = "text")

Table

sjPlot::tab_xtab(var.row = egos$deg.main, 
                 var.col = egos$region, 
                 weight.by = egos$ego.wawt,
                 title = "Main degree by region",
                 show.col.prc = T,
                 show.summary = F)

Main degree by region

deg.main	region			Total
	EasternWA	King	WesternWA
0	63 75.9 %	340 72.2 %	210 75.8 %	613 73.8 %
1	14 16.9 %	122 25.9 %	63 22.7 %	199 23.9 %
2	6 7.2 %	8 1.7 %	4 1.4 %	18 2.2 %
3	0 0 %	1 0.2 %	0 0 %	1 0.1 %
Total	83 100 %	471 100 %	277 100 %	831 100 %

maindeg <- list(all = main.deg,
                age = age.deg,
                race = race.deg,
                region = region.deg)

---

Casl

Overall

casl.deg <- egos %>%
  group_by(deg.casl) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

Plot

p <- ggplot(casl.deg, aes(x=factor(deg.casl), y=prop.wtd, 
            text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(fill = "blue", alpha = 0.5, stat = "identity") +
  labs(title = "Casual active partnerships",
       x = "degree",
       y = "wtd proportion")

ggplotly(p, tooltip = "text")

Table

casl.deg %>% kable(caption= "Casual") %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Casual

deg.casl	nobs	n.wtd	prop.wtd
0	398	391.4	0.47
1	250	250.5	0.30
2	90	91.3	0.11
3	63	65.0	0.08
4	27	27.6	0.03
5	4	6.2	0.01

Age

tempDF <- egos %>%
  group_by(deg.casl, age.grp) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  group_by(age.grp) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

age.deg <- tempDF

Plot

p <- ggplot(tempDF, 
            aes(x=factor(deg.casl), y=prop.wtd,
                group = age.grp, fill = factor(age.grp),
                text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(alpha = 0.7, stat = "identity", position = "dodge") +
  labs(title = "Casual active partnerships",
       x = "degree",
       y = "wtd proportion",
       fill = "age group") +
  scale_fill_brewer() +
  theme_bw()

ggplotly(p, tooltip = "text")

Table

sjPlot::tab_xtab(var.row = egos$deg.casl, 
                 var.col = egos$age.grp, 
                 weight.by = egos$ego.wawt,
                 title = "Casual by age group",
                 show.col.prc = T,
                 show.summary = F)

Casual by age group

deg.casl	age.grp					Total
	1	2	3	4	5
0	105 73.9 %	120 56.6 %	64 36.2 %	56 36.6 %	46 31.5 %	391 47.1 %
1	30 21.1 %	50 23.6 %	66 37.3 %	56 36.6 %	48 32.9 %	250 30.1 %
2	3 2.1 %	26 12.3 %	21 11.9 %	18 11.8 %	23 15.8 %	91 11 %
3	3 2.1 %	14 6.6 %	16 9 %	15 9.8 %	16 11 %	64 7.7 %
4	1 0.7 %	2 0.9 %	7 4 %	6 3.9 %	12 8.2 %	28 3.4 %
5	0 0 %	0 0 %	3 1.7 %	2 1.3 %	1 0.7 %	6 0.7 %
Total	142 100 %	212 100 %	177 100 %	153 100 %	146 100 %	830 100 %

---

Race

tempDF <- egos %>%
  group_by(deg.casl, race) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  group_by(race) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

race.deg <- tempDF

Plot

p <- ggplot(tempDF, 
            aes(x=factor(deg.casl), y=prop.wtd, 
                group = race, fill = factor(race),
                text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(alpha = 0.7, 
           stat = "identity", 
           position = "dodge") +
  labs(title = "Casual active partnerships",
       x = "degree",
       y = "wtd proportion",
       fill = "race")

ggplotly(p, tooltip = "text")

Table

sjPlot::tab_xtab(var.row = egos$deg.casl, 
                 var.col = egos$race, 
                 weight.by = egos$ego.wawt,
                 title = "Casual by age group",
                 show.col.prc = T,
                 show.summary = F)

Casual by age group

deg.casl	race			Total
	B	H	O
0	26 46.4 %	44 47.3 %	321 46.9 %	391 46.9 %
1	5 8.9 %	28 30.1 %	217 31.7 %	250 30 %
2	11 19.6 %	11 11.8 %	70 10.2 %	92 11 %
3	7 12.5 %	5 5.4 %	53 7.7 %	65 7.8 %
4	2 3.6 %	5 5.4 %	21 3.1 %	28 3.4 %
5	5 8.9 %	0 0 %	2 0.3 %	7 0.8 %
Total	56 100 %	93 100 %	684 100 %	833 100 %

---

Region

tempDF <- egos %>%
  group_by(deg.casl, region) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  group_by(region) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

region.deg <- tempDF

Plot

p <- ggplot(tempDF, 
            aes(x=factor(deg.casl), y=prop.wtd, 
                group = region, fill = factor(region),
                text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(alpha = 0.7, 
           stat = "identity", 
           position = "dodge") +
  labs(title = "Casual active partnerships",
       x = "degree",
       y = "wtd proportion",
       fill = "region")

ggplotly(p, tooltip = "text")

Table

sjPlot::tab_xtab(var.row = egos$deg.casl, 
                 var.col = egos$region, 
                 weight.by = egos$ego.wawt,
                 title = "Casual by region",
                 show.col.prc = T,
                 show.summary = F)

Casual by region

deg.casl	region			Total
	EasternWA	King	WesternWA
0	46 55.4 %	216 45.8 %	129 46.2 %	391 46.9 %
1	23 27.7 %	148 31.4 %	80 28.7 %	251 30.1 %
2	8 9.6 %	61 12.9 %	23 8.2 %	92 11 %
3	5 6 %	32 6.8 %	28 10 %	65 7.8 %
4	0 0 %	13 2.8 %	15 5.4 %	28 3.4 %
5	1 1.2 %	2 0.4 %	4 1.4 %	7 0.8 %
Total	83 100 %	472 100 %	279 100 %	834 100 %

casldeg <- list(all = casl.deg,
                age = age.deg,
                race = race.deg,
                region = region.deg)

---

Onetime partners

Onetime partnerships do not have persistence, so technically there is no “degree” measure. The closest equivalent is the number of onetime partners per week.

We do not ask the weekly count of onetime parters directly in the WHAMP survey. So we construct our observed target from the annual count, count.oo.part:

count.oo.wk = round(count.oo.part/52)

This will have a smoothing effect across the year, so is likely to underestimate the true weekly maximum in the data.

Overall

inst.wk <- egos %>%
  group_by(count.oo.wk) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

Plot

p <- ggplot(inst.wk, aes(x=factor(count.oo.wk), y=prop.wtd, 
            text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(fill = "blue", alpha = 0.5, stat = "identity") +
  labs(title = "Onetime partners per wk",
       x = "degree",
       y = "wtd proportion")

ggplotly(p, tooltip = "text")

Table

inst.wk %>% kable(caption= "Onetime partners per wk") %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Onetime partners per wk

count.oo.wk	nobs	n.wtd	prop.wtd
0	788	788.5	0.95
1	39	38.5	0.05
2	5	5.0	0.01

Age

tempDF <- egos %>%
  group_by(count.oo.wk, age.grp) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  group_by(age.grp) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

age.wk <- tempDF

Plot

p <- ggplot(tempDF, 
            aes(x=factor(count.oo.wk), y=prop.wtd,
                group = age.grp, fill = factor(age.grp),
                text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(alpha = 0.7, stat = "identity", position = "dodge") +
  labs(title = "Onetime partners per wk distribution",
       x = "degree",
       y = "wtd proportion",
       fill = "age group") +
  scale_fill_brewer() +
  theme_bw()

ggplotly(p, tooltip = "text")

Table

sjPlot::tab_xtab(var.row = egos$count.oo.wk, 
                 var.col = egos$age.grp, 
                 weight.by = egos$ego.wawt,
                 title = "Onetime partners per wk by age group",
                 show.col.prc = T,
                 show.summary = F)

Onetime partners per wk by age group

count.oo.wk	age.grp					Total
	1	2	3	4	5
0	142 98.6 %	195 92 %	165 93.2 %	145 94.8 %	142 96.6 %	789 94.7 %
1	2 1.4 %	16 7.5 %	10 5.6 %	8 5.2 %	3 2 %	39 4.7 %
2	0 0 %	1 0.5 %	2 1.1 %	0 0 %	2 1.4 %	5 0.6 %
Total	144 100 %	212 100 %	177 100 %	153 100 %	147 100 %	833 100 %

---

Race

tempDF <- egos %>%
  group_by(count.oo.wk, race) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  group_by(race) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

race.wk <- tempDF

Plot

p <- ggplot(tempDF, 
            aes(x=factor(count.oo.wk), y=prop.wtd, 
                group = race, fill = factor(race),
                text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(alpha = 0.7, 
           stat = "identity", 
           position = "dodge") +
  labs(title = "Onetime partners per wk distribution",
       x = "degree",
       y = "wtd proportion",
       fill = "race")

ggplotly(p, tooltip = "text")

Table

sjPlot::tab_xtab(var.row = egos$count.oo.wk, 
                 var.col = egos$race, 
                 weight.by = egos$ego.wawt,
                 title = "Onetime partners per wk by age group",
                 show.col.prc = T,
                 show.summary = F)

Onetime partners per wk by age group

count.oo.wk	race			Total
	B	H	O
0	51 91.1 %	88 94.6 %	650 95 %	789 94.7 %
1	5 8.9 %	5 5.4 %	29 4.2 %	39 4.7 %
2	0 0 %	0 0 %	5 0.7 %	5 0.6 %
Total	56 100 %	93 100 %	684 100 %	833 100 %

---

Region

tempDF <- egos %>%
  group_by(count.oo.wk, region) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  group_by(region) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

region.wk <- tempDF

Plot

p <- ggplot(tempDF, 
            aes(x=factor(count.oo.wk), y=prop.wtd, 
                group = region, fill = factor(region),
                text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(alpha = 0.7, 
           stat = "identity", 
           position = "dodge") +
  labs(title = "Onetime partners per wk distribution",
       x = "degree",
       y = "wtd proportion",
       fill = "region")

ggplotly(p, tooltip = "text")

Table

sjPlot::tab_xtab(var.row = egos$count.oo.wk, 
                 var.col = egos$region, 
                 weight.by = egos$ego.wawt,
                 title = "Onetime partners per wk by region",
                 show.col.prc = T,
                 show.summary = F)

Onetime partners per wk by region

count.oo.wk	region			Total
	EasternWA	King	WesternWA
0	80 96.4 %	445 94.3 %	264 95 %	789 94.7 %
1	3 3.6 %	25 5.3 %	11 4 %	39 4.7 %
2	0 0 %	2 0.4 %	3 1.1 %	5 0.6 %
Total	83 100 %	472 100 %	278 100 %	833 100 %

instwk <- list(all = inst.wk,
               age = age.wk,
               race = race.wk,
               region = region.wk)

Crosstab degdists

Main x Casl

sjPlot::tab_xtab(var.row = egos$deg.main, 
                 var.col = egos$deg.casl, 
                 weight.by = egos$ego.wawt,
                 title = "Main x Casl active partnerships",
                 show.row.prc = T,
                 show.col.prc = T,
                 show.cell.prc = T,
                 show.summary = F)

Main x Casl active partnerships

deg.main	deg.casl						Total
	0	1	2	3	4	5
0	252 41.1 % 64.5 % 30.3 %	216 35.2 % 86.1 % 26 %	65 10.6 % 70.7 % 7.8 %	52 8.5 % 80 % 6.2 %	22 3.6 % 81.5 % 2.6 %	6 1 % 100 % 0.7 %	613 100 % 73.7 % 73.6 %
1	133 66.8 % 34 % 16 %	29 14.6 % 11.6 % 3.5 %	21 10.6 % 22.8 % 2.5 %	11 5.5 % 16.9 % 1.3 %	5 2.5 % 18.5 % 0.6 %	0 0 % 0 % 0 %	199 100 % 23.9 % 23.9 %
2	5 26.3 % 1.3 % 0.6 %	6 31.6 % 2.4 % 0.7 %	6 31.6 % 6.5 % 0.7 %	2 10.5 % 3.1 % 0.2 %	0 0 % 0 % 0 %	0 0 % 0 % 0 %	19 100 % 2.3 % 2.2 %
3	1 100 % 0.3 % 0.1 %	0 0 % 0 % 0 %	0 0 % 0 % 0 %	0 0 % 0 % 0 %	0 0 % 0 % 0 %	0 0 % 0 % 0 %	1 100 % 0.1 % 0.1 %
Total	391 47 % 100 % 47 %	251 30.2 % 100 % 30.2 %	92 11.1 % 100 % 11.1 %	65 7.8 % 100 % 7.8 %	27 3.2 % 100 % 3.2 %	6 0.7 % 100 % 0.7 %	832 100 % 100 % 100 %

xnet.mc <- egos %>%
  group_by(deg.main, deg.casl) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

Main x Onetime

sjPlot::tab_xtab(var.row = egos$deg.main, 
                 var.col = egos$count.oo.wk, 
                 weight.by = egos$ego.wawt,
                 title = "Main active x Onetime/wk partnerships",
                 show.row.prc = T,
                 show.col.prc = T,
                 show.cell.prc = T,
                 show.summary = F)

Main active x Onetime/wk partnerships

deg.main	count.oo.wk			Total
	0	1	2
0	586 95.4 % 74.3 % 70.3 %	24 3.9 % 61.5 % 2.9 %	4 0.7 % 80 % 0.5 %	614 100 % 73.7 % 73.7 %
1	188 94.5 % 23.8 % 22.6 %	10 5 % 25.6 % 1.2 %	1 0.5 % 20 % 0.1 %	199 100 % 23.9 % 23.9 %
2	15 78.9 % 1.9 % 1.8 %	4 21.1 % 10.3 % 0.5 %	0 0 % 0 % 0 %	19 100 % 2.3 % 2.3 %
3	0 0 % 0 % 0 %	1 100 % 2.6 % 0.1 %	0 0 % 0 % 0 %	1 100 % 0.1 % 0.1 %
Total	789 94.7 % 100 % 94.7 %	39 4.7 % 100 % 4.7 %	5 0.6 % 100 % 0.6 %	833 100 % 100 % 100 %

xnet.mi <- egos %>%
  group_by(deg.main, count.oo.wk) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

Casl x Onetime

sjPlot::tab_xtab(var.row = egos$deg.casl, 
                 var.col = egos$count.oo.wk, 
                 weight.by = egos$ego.wawt,
                 title = "Casl active x Onetime/wk partnerships",
                 show.row.prc = T,
                 show.col.prc = T,
                 show.cell.prc = T,
                 show.summary = F)

Casl active x Onetime/wk partnerships

deg.casl	count.oo.wk			Total
	0	1	2
0	389 99.2 % 49.2 % 46.6 %	3 0.8 % 7.7 % 0.4 %	0 0 % 0 % 0 %	392 100 % 47 % 47 %
1	236 94 % 29.9 % 28.3 %	13 5.2 % 33.3 % 1.6 %	2 0.8 % 40 % 0.2 %	251 100 % 30.1 % 30.1 %
2	78 84.8 % 9.9 % 9.4 %	14 15.2 % 35.9 % 1.7 %	0 0 % 0 % 0 %	92 100 % 11 % 11.1 %
3	58 89.2 % 7.3 % 7 %	7 10.8 % 17.9 % 0.8 %	0 0 % 0 % 0 %	65 100 % 7.8 % 7.8 %
4	24 88.9 % 3 % 2.9 %	1 3.7 % 2.6 % 0.1 %	2 7.4 % 40 % 0.2 %	27 100 % 3.2 % 3.2 %
5	5 71.4 % 0.6 % 0.6 %	1 14.3 % 2.6 % 0.1 %	1 14.3 % 20 % 0.1 %	7 100 % 0.8 % 0.8 %
Total	790 94.7 % 100 % 94.7 %	39 4.7 % 100 % 4.7 %	5 0.6 % 100 % 0.6 %	834 100 % 100 % 100 %

xnet.ci <- egos %>%
  group_by(deg.casl, count.oo.wk) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

xnet <- list(xnet.mc = xnet.mc,
             xnet.mi = xnet.mi,
             xnet.ci = xnet.ci)

---

Mean degree (active)

• “tot” in the resulst below is total persistent partners: Main + Casual
• “inst” is the average number of one-time partners per week

Overall

tot.mdeg <- egos %>%
  summarise(main = weighted.mean(deg.main, ego.wawt),
            casl = weighted.mean(deg.casl, ego.wawt),
            tot = weighted.mean(deg.tot, ego.wawt),
            inst = weighted.mean(count.oo.wk, ego.wawt)) %>%
  tidyr::pivot_longer(cols = main:inst,
                      names_to = "measure")

Plot

p <- ggplot(tot.mdeg, 
            aes(x=factor(measure, levels=measure), 
                y=value, 
                text = scales::percent(value, acc = .2))) +
  geom_bar(fill = "blue", alpha = 0.5, stat = "identity") +
  labs(title = "Overall mean degree",
       x = "Partner type",
       y = "mean degree")

ggplotly(p, tooltip = "text")

Table

tot.mdeg %>% kable(caption= "Mean degree",
                   digits = c(0, 2)) %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Mean degree

measure	value
main	0.29
casl	0.92
tot	1.21
inst	0.06

Age

tot.mdeg <- egos %>%
  group_by(age.grp) %>%
  summarise(main = weighted.mean(deg.main, ego.wawt),
            casl = weighted.mean(deg.casl, ego.wawt),
            tot = weighted.mean(deg.tot, ego.wawt),
            inst = weighted.mean(count.oo.wk, ego.wawt)) 

Plot

p <- ggplot(tot.mdeg %>%
              tidyr::pivot_longer(cols = main:inst,
                                  names_to = "measure") %>%
              mutate(measure = factor(measure, levels=colnames(tot.mdeg)[-1])), 
            aes(x=age.grp, y=value,
                group=measure, color=measure), 
            text = scales::percent(value, acc = .2)) +
  geom_point() +
  geom_line() +
  labs(title = "Mean degree by age and partner type",
       x = "Age Group",
       y = "mean degree")

ggplotly(p, tooltip = "text")

Table

tot.mdeg %>% kable(caption= "Mean degree",
                   digits = c(0, rep(2,5))) %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Mean degree

age.grp	main	casl	tot	inst
1	0.29	0.36	0.65	0.01
2	0.40	0.71	1.11	0.08
3	0.31	1.13	1.44	0.08
4	0.20	1.11	1.31	0.05
5	0.19	1.34	1.53	0.05

---

Race

tot.mdeg <- egos %>%
  group_by(race) %>%
  summarise(main = weighted.mean(deg.main, ego.wawt),
            casl = weighted.mean(deg.casl, ego.wawt),
            tot = weighted.mean(deg.tot, ego.wawt),
            inst = weighted.mean(count.oo.wk, ego.wawt)) 

Plot

p <- ggplot(tot.mdeg %>%
              tidyr::pivot_longer(cols = main:inst,
                                  names_to = "measure") %>%
              mutate(measure = factor(measure, levels=colnames(tot.mdeg)[-1])), 
            aes(x=race, y=value,
                group=measure, color=measure), 
            text = scales::percent(value, acc = .2)) +
  geom_point() +
  geom_line() +
  labs(title = "Mean degree by race and partner type",
       x = "Race",
       y = "mean degree")

ggplotly(p, tooltip = "text")

Table

tot.mdeg %>% kable(caption= "Mean degree",
                   digits = c(0, rep(2,5))) %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Mean degree

race	main	casl	tot	inst
B	0.24	1.41	1.65	0.08
H	0.32	0.90	1.22	0.06
O	0.29	0.89	1.17	0.06

---

Region

tot.mdeg <- egos %>%
  group_by(region) %>%
  summarise(main = weighted.mean(deg.main, ego.wawt),
            casl = weighted.mean(deg.casl, ego.wawt),
            tot = weighted.mean(deg.tot, ego.wawt),
            inst = weighted.mean(count.oo.wk, ego.wawt)) 

Plot

p <- ggplot(tot.mdeg %>%
              tidyr::pivot_longer(cols = main:inst,
                                  names_to = "measure") %>%
              mutate(measure = factor(measure, levels=colnames(tot.mdeg)[-1])), 
            aes(x=region, y=value,
                group=measure, color=measure), 
            text = scales::percent(value, acc = .2)) +
  geom_point() +
  geom_line() +
  labs(title = "Mean degree by region and partner type",
       x = "Region",
       y = "mean degree")

ggplotly(p, tooltip = "text")

Table

tot.mdeg %>% kable(caption= "Mean degree",
                   digits = c(0, rep(2,5))) %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Mean degree

region	main	casl	tot	inst
EasternWA	0.31	0.69	1.00	0.04
King	0.30	0.91	1.21	0.06
WesternWA	0.26	1.03	1.28	0.06

---

Age x Race

Note we only have one observation for Black in age.grp 1, so we treat that mean as NA.

tot.mdeg <- egos %>%
  group_by(age.grp, race) %>%
  summarise(nobs = n(),
            main = weighted.mean(deg.main, ego.wawt),
            casl = weighted.mean(deg.casl, ego.wawt),
            tot = weighted.mean(deg.tot, ego.wawt),
            inst = weighted.mean(count.oo.wk, ego.wawt)) %>%
  mutate_at(vars(main:inst), ~ifelse(nobs<2, NA, .x)) %>%
  select(-nobs)

Plot

p <- ggplot(tot.mdeg %>%
              tidyr::pivot_longer(cols = main:inst,
                                  names_to = "measure") %>%
              mutate(measure = factor(measure,
                                      levels=colnames(tot.mdeg)[-c(1,2)])), 
            aes(x=age.grp, y=value,
                group=measure, color=measure), 
            text = scales::percent(value, acc = .2)) +
  facet_wrap(~ race) +
  geom_point() +
  geom_line() +
  labs(title = "Mean degree by age, race and partner type",
       x = "Age",
       y = "mean degree")

ggplotly(p, tooltip = "text")

Table

tot.mdeg %>% kable(caption= "Mean degree",
                   digits = c(0, 0, rep(2,4))) %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Mean degree

age.grp	race	main	casl	tot	inst
1	B	NA	NA	NA	NA
1	H	0.14	0.61	0.75	0.05
1	O	0.35	0.34	0.69	0.01
2	B	0.40	0.82	1.21	0.23
2	H	0.31	0.82	1.13	0.09
2	O	0.41	0.68	1.09	0.06
3	B	0.00	2.23	2.23	0.00
3	H	0.69	1.26	1.94	0.07
3	O	0.28	1.00	1.28	0.09
4	B	0.46	2.41	2.87	0.00
4	H	0.00	0.50	0.50	0.00
4	O	0.19	1.04	1.23	0.06
5	H	0.29	1.81	2.10	0.00
5	O	0.18	1.32	1.50	0.05

---

Age x Region

tot.mdeg <- egos %>%
  group_by(age.grp, region) %>%
  summarise(main = weighted.mean(deg.main, ego.wawt),
            casl = weighted.mean(deg.casl, ego.wawt),
            tot = weighted.mean(deg.tot, ego.wawt),
            inst = weighted.mean(count.oo.wk, ego.wawt)) 

Plot

p <- ggplot(tot.mdeg %>%
              tidyr::pivot_longer(cols = main:inst,
                                  names_to = "measure") %>%
              mutate(measure = factor(measure, 
                                      levels=colnames(tot.mdeg)[-c(1,2)])), 
            aes(x=age.grp, y=value,
                group=measure, color=measure), 
            text = scales::percent(value, acc = .2)) +
  facet_wrap(~ region) +
  geom_point() +
  geom_line() +
  labs(title = "Mean degree by age, region and partner type",
       x = "Region",
       y = "mean degree")

ggplotly(p, tooltip = "text")

Table

tot.mdeg %>% kable(caption= "Mean degree",
                   digits = c(0, 0, rep(2,4))) %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Mean degree

age.grp	region	main	casl	tot	inst
1	EasternWA	0.31	0.17	0.48	0.03
1	King	0.22	0.40	0.62	0.02
1	WesternWA	0.38	0.39	0.78	0.00
2	EasternWA	0.39	0.49	0.88	0.00
2	King	0.47	0.77	1.24	0.09
2	WesternWA	0.26	0.65	0.91	0.09
3	EasternWA	0.48	1.04	1.52	0.14
3	King	0.30	1.13	1.43	0.10
3	WesternWA	0.28	1.16	1.44	0.03
4	EasternWA	0.14	0.64	0.79	0.00
4	King	0.24	1.05	1.29	0.06
4	WesternWA	0.13	1.31	1.44	0.05
5	EasternWA	0.12	1.29	1.41	0.00
5	King	0.17	1.16	1.33	0.02
5	WesternWA	0.23	1.60	1.83	0.11

---

Cumulative Partners (annual)

Total

• Sum of main, casual and one-time partners: snap
• For tabulation, will truncate at 20+, but the plot shows that the more natural topcode is 10+, reflecting a bimodal distribution.

Overall

egos <- egos %>% mutate(snap20 = ifelse(snap <20, snap, 20))

tot.yr <- egos %>%
  group_by(snap20) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

Plot

p <- ggplot(tot.yr, aes(x = snap20, y=prop.wtd,
                   text = round(100*prop.wtd, 3))) +
  geom_point(color = "blue", alpha = 0.5) +
  geom_line(color = "blue") +
  labs(title = "Total annual partner count (topcoded at 20)",
       x = "count",
       y = "wtd proportion") +
  scale_x_continuous(breaks = 0:20)

ggplotly(p, tooltip = "text")

Table

tot.yr %>% kable(caption= "Total annual partner count (topcoded at 20+") %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Total annual partner count (topcoded at 20+

snap20	nobs	n.wtd	prop.wtd
0	89	86.4	0.10
1	273	274.5	0.33
2	88	83.9	0.10
3	63	65.0	0.08
4	46	48.0	0.06
5	41	45.2	0.05
6	28	27.5	0.03
7	14	13.1	0.02
8	23	22.8	0.03
9	7	7.2	0.01
10	30	28.6	0.03
11	4	3.1	0.00
12	18	18.6	0.02
14	1	0.9	0.00
15	22	21.8	0.03
16	2	2.2	0.00
18	2	2.8	0.00
20	81	80.4	0.10

Age

tempDF <- egos %>%
  group_by(snap20, age.grp) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  group_by(age.grp) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

age.yr <- tempDF

Plot

p <- ggplot(tempDF, aes(x = snap20, y=prop.wtd,
                        group = factor(age.grp), 
                        color = factor(age.grp),   
                        text = round(100*prop.wtd, 3))) +
  geom_point(alpha = 0.5) +
  geom_line() +
  labs(title = "Total annual partner count (topcoded at 20)",
       x = "count",
       y = "wtd proportion",
       color = "Age Group") +
  scale_x_continuous(breaks = 0:20) +
  scale_color_brewer() +
  theme_bw()

ggplotly(p, tooltip = "text")

Table

sjPlot::tab_xtab(var.row = egos$snap20,
                 var.col = egos$age.grp, 
                 weight.by = egos$ego.wawt,
                 title = "Total annual partner count by age group",
                 show.col.prc = T,
                 show.summary = F)

Total annual partner count by age group

snap20	age.grp					Total
	1	2	3	4	5
0	18 12.5 %	15 7.1 %	18 10.3 %	18 11.6 %	18 12.2 %	87 10.4 %
1	58 40.3 %	83 39.2 %	48 27.4 %	46 29.7 %	39 26.5 %	274 32.9 %
2	21 14.6 %	24 11.3 %	14 8 %	11 7.1 %	14 9.5 %	84 10.1 %
3	9 6.2 %	14 6.6 %	18 10.3 %	9 5.8 %	14 9.5 %	64 7.7 %
4	7 4.9 %	9 4.2 %	12 6.9 %	12 7.7 %	8 5.4 %	48 5.8 %
5	10 6.9 %	11 5.2 %	11 6.3 %	8 5.2 %	5 3.4 %	45 5.4 %
6	6 4.2 %	3 1.4 %	5 2.9 %	8 5.2 %	6 4.1 %	28 3.4 %
7	1 0.7 %	3 1.4 %	3 1.7 %	2 1.3 %	4 2.7 %	13 1.6 %
8	2 1.4 %	4 1.9 %	6 3.4 %	5 3.2 %	6 4.1 %	23 2.8 %
9	1 0.7 %	2 0.9 %	3 1.7 %	0 0 %	1 0.7 %	7 0.8 %
10	1 0.7 %	8 3.8 %	6 3.4 %	7 4.5 %	7 4.8 %	29 3.5 %
11	1 0.7 %	1 0.5 %	0 0 %	1 0.6 %	0 0 %	3 0.4 %
12	0 0 %	2 0.9 %	3 1.7 %	3 1.9 %	11 7.5 %	19 2.3 %
14	0 0 %	0 0 %	1 0.6 %	0 0 %	0 0 %	1 0.1 %
15	4 2.8 %	6 2.8 %	2 1.1 %	6 3.9 %	4 2.7 %	22 2.6 %
16	0 0 %	0 0 %	1 0.6 %	1 0.6 %	0 0 %	2 0.2 %
18	0 0 %	0 0 %	3 1.7 %	0 0 %	0 0 %	3 0.4 %
20	5 3.5 %	27 12.7 %	21 12 %	18 11.6 %	10 6.8 %	81 9.7 %
Total	144 100 %	212 100 %	175 100 %	155 100 %	147 100 %	833 100 %

---

Race

tempDF <- egos %>%
  group_by(snap20, race) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  group_by(race) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

race.yr <- tempDF

Plot

p <- ggplot(tempDF, aes(x = snap20, y=prop.wtd,
                        group = race, 
                        color = race,   
                        text = round(100*prop.wtd, 3))) +
  geom_point(alpha = 0.5) +
  geom_line() +
  labs(title = "Total annual partner count (topcoded at 20)",
       x = "count",
       y = "wtd proportion",
       color = "Race") +
  scale_x_continuous(breaks = 0:20) 

ggplotly(p, tooltip = "text")

Table

sjPlot::tab_xtab(var.row = egos$snap20,
                 var.col = egos$race, 
                 weight.by = egos$ego.wawt,
                 title = "Total annual partner count by race",
                 show.col.prc = T,
                 show.summary = F)

Total annual partner count by race

snap20	race			Total
	B	H	O
0	0 0 %	9 9.6 %	77 11.2 %	86 10.3 %
1	17 29.8 %	32 34 %	226 33 %	275 32.9 %
2	2 3.5 %	8 8.5 %	74 10.8 %	84 10 %
3	6 10.5 %	13 13.8 %	47 6.9 %	66 7.9 %
4	11 19.3 %	2 2.1 %	35 5.1 %	48 5.7 %
5	8 14 %	5 5.3 %	33 4.8 %	46 5.5 %
6	0 0 %	4 4.3 %	24 3.5 %	28 3.3 %
7	0 0 %	1 1.1 %	12 1.8 %	13 1.6 %
8	3 5.3 %	2 2.1 %	18 2.6 %	23 2.8 %
9	0 0 %	1 1.1 %	6 0.9 %	7 0.8 %
10	0 0 %	5 5.3 %	24 3.5 %	29 3.5 %
11	0 0 %	0 0 %	3 0.4 %	3 0.4 %
12	2 3.5 %	1 1.1 %	16 2.3 %	19 2.3 %
14	0 0 %	0 0 %	1 0.1 %	1 0.1 %
15	1 1.8 %	1 1.1 %	20 2.9 %	22 2.6 %
16	0 0 %	1 1.1 %	1 0.1 %	2 0.2 %
18	0 0 %	2 2.1 %	1 0.1 %	3 0.4 %
20	7 12.3 %	7 7.4 %	67 9.8 %	81 9.7 %
Total	57 100 %	94 100 %	685 100 %	836 100 %

---

Region

tempDF <- egos %>%
  group_by(snap20, region) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  group_by(region) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

region.yr <- tempDF

Plot

p <- ggplot(tempDF, aes(x = snap20, y=prop.wtd,
                        group = region, 
                        color = region,   
                        text = round(100*prop.wtd, 3))) +
  geom_point(alpha = 0.5) +
  geom_line() +
  labs(title = "Total annual partner count (topcoded at 20)",
       x = "count",
       y = "wtd proportion",
       color = "region") +
  scale_x_continuous(breaks = 0:20) 

ggplotly(p, tooltip = "text")

Table

sjPlot::tab_xtab(var.row = egos$snap20,
                 var.col = egos$region, 
                 weight.by = egos$ego.wawt,
                 title = "Total annual partner count by region",
                 show.col.prc = T,
                 show.summary = F)

Total annual partner count by region

snap20	region			Total
	EasternWA	King	WesternWA
0	10 12 %	39 8.3 %	38 13.7 %	87 10.5 %
1	24 28.9 %	169 35.9 %	81 29.1 %	274 32.9 %
2	12 14.5 %	48 10.2 %	24 8.6 %	84 10.1 %
3	10 12 %	36 7.6 %	19 6.8 %	65 7.8 %
4	5 6 %	21 4.5 %	23 8.3 %	49 5.9 %
5	2 2.4 %	25 5.3 %	18 6.5 %	45 5.4 %
6	1 1.2 %	15 3.2 %	12 4.3 %	28 3.4 %
7	2 2.4 %	7 1.5 %	4 1.4 %	13 1.6 %
8	3 3.6 %	12 2.5 %	7 2.5 %	22 2.6 %
9	0 0 %	5 1.1 %	2 0.7 %	7 0.8 %
10	3 3.6 %	18 3.8 %	8 2.9 %	29 3.5 %
11	1 1.2 %	1 0.2 %	1 0.4 %	3 0.4 %
12	2 2.4 %	10 2.1 %	6 2.2 %	18 2.2 %
14	0 0 %	0 0 %	1 0.4 %	1 0.1 %
15	1 1.2 %	13 2.8 %	8 2.9 %	22 2.6 %
16	0 0 %	0 0 %	2 0.7 %	2 0.2 %
18	2 2.4 %	1 0.2 %	0 0 %	3 0.4 %
20	5 6 %	51 10.8 %	24 8.6 %	80 9.6 %
Total	83 100 %	471 100 %	278 100 %	832 100 %

totyr <- list(all = tot.yr,
              age = age.yr,
              race = race.yr,
              region = region.yr)

---

Main

Overall

main.yr <- egos %>%
  group_by(mod.main) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2)) %>%
  merge(expand.grid(mod.main=0:5), 
        by="mod.main", all=T)
main.yr[is.na(main.yr)] <- 0

Plot

p <- ggplot(main.yr, aes(x=factor(mod.main), y=prop.wtd, 
            text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(fill = "blue", alpha = 0.5, stat = "identity") +
  labs(title = "Main partners last year",
       x = "count",
       y = "wtd proportion")

ggplotly(p, tooltip = "text")

Table

main.yr %>% kable(caption= "Main degree") %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Main degree

mod.main	nobs	n.wtd	prop.wtd
0	584	591.4	0.71
1	220	210.9	0.25
2	26	27.9	0.03
3	1	1.1	0.00
4	1	0.7	0.00
5	0	0.0	0.00

Age

tempDF <- egos %>%
  group_by(mod.main, age.grp) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  group_by(age.grp) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

age.yr <- tempDF

Plot

p <- ggplot(tempDF, 
            aes(x=factor(mod.main), y=prop.wtd,
                group = age.grp, fill = factor(age.grp),
                text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(alpha = 0.7, stat = "identity", position = "dodge") +
  labs(title = "Main partners last year",
       x = "count",
       y = "wtd proportion",
       fill = "age group") +
  scale_fill_brewer() +
  theme_bw()

ggplotly(p, tooltip = "text")

Table

sjPlot::tab_xtab(var.row = egos$mod.main, 
                 var.col = egos$age.grp, 
                 weight.by = egos$ego.wawt,
                 title = "Main partners last year by age group",
                 show.col.prc = T,
                 show.summary = F)

Main partners last year by age group

mod.main	age.grp					Total
	1	2	3	4	5
0	97 67.4 %	118 55.7 %	132 74.6 %	123 80.4 %	121 82.3 %	591 70.9 %
1	41 28.5 %	87 41 %	35 19.8 %	27 17.6 %	22 15 %	212 25.5 %
2	6 4.2 %	6 2.8 %	9 5.1 %	3 2 %	4 2.7 %	28 3.4 %
3	0 0 %	0 0 %	1 0.6 %	0 0 %	0 0 %	1 0.1 %
4	0 0 %	1 0.5 %	0 0 %	0 0 %	0 0 %	1 0.1 %
Total	144 100 %	212 100 %	177 100 %	153 100 %	147 100 %	833 100 %

---

Race

tempDF <- egos %>%
  group_by(mod.main, race) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  group_by(race) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

race.yr <- tempDF

Plot

p <- ggplot(tempDF, 
            aes(x=factor(mod.main), y=prop.wtd, 
                group = race, fill = factor(race),
                text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(alpha = 0.7, 
           stat = "identity", 
           position = "dodge") +
  labs(title = "Main partners last year",
       x = "count",
       y = "wtd proportion",
       fill = "race")

ggplotly(p, tooltip = "text")

Table

sjPlot::tab_xtab(var.row = egos$mod.main, 
                 var.col = egos$race, 
                 weight.by = egos$ego.wawt,
                 title = "Main partners last year by age group",
                 show.col.prc = T,
                 show.summary = F)

Main partners last year by age group

mod.main	race			Total
	B	H	O
0	42 75 %	69 74.2 %	481 70.3 %	592 71.1 %
1	11 19.6 %	16 17.2 %	183 26.8 %	210 25.2 %
2	3 5.4 %	8 8.6 %	18 2.6 %	29 3.5 %
3	0 0 %	0 0 %	1 0.1 %	1 0.1 %
4	0 0 %	0 0 %	1 0.1 %	1 0.1 %
Total	56 100 %	93 100 %	684 100 %	833 100 %

---

Region

tempDF <- egos %>%
  group_by(mod.main, region) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  group_by(region) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

region.yr <- tempDF

Plot

p <- ggplot(tempDF, 
            aes(x=factor(mod.main), y=prop.wtd, 
                group = region, fill = factor(region),
                text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(alpha = 0.7, 
           stat = "identity", 
           position = "dodge") +
  labs(title = "Main partners last year",
       x = "count",
       y = "wtd proportion",
       fill = "region")

ggplotly(p, tooltip = "text")

Table

sjPlot::tab_xtab(var.row = egos$mod.main, 
                 var.col = egos$region, 
                 weight.by = egos$ego.wawt,
                 title = "Main partners last year by region",
                 show.col.prc = T,
                 show.summary = F)

Main partners last year by region

mod.main	region			Total
	EasternWA	King	WesternWA
0	59 71.1 %	331 70.1 %	202 72.7 %	592 71.1 %
1	16 19.3 %	128 27.1 %	67 24.1 %	211 25.3 %
2	7 8.4 %	12 2.5 %	9 3.2 %	28 3.4 %
3	0 0 %	1 0.2 %	0 0 %	1 0.1 %
4	1 1.2 %	0 0 %	0 0 %	1 0.1 %
Total	83 100 %	472 100 %	278 100 %	833 100 %

mainyr <- list(all = main.yr,
              age = age.yr,
              race = race.yr,
              region = region.yr)

---

Casl

Overall

casl.yr <- egos %>%
  group_by(mod.casl) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2)) %>%
  merge(expand.grid(mod.casl=0:5), 
        by="mod.casl", all=T)
casl.yr[is.na(casl.yr)] <- 0

Plot

p <- ggplot(casl.yr, aes(x=factor(mod.casl), y=prop.wtd, 
            text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(fill = "blue", alpha = 0.5, stat = "identity") +
  labs(title = "Casual partners last year",
       x = "count",
       y = "wtd proportion")

ggplotly(p, tooltip = "text")

Table

casl.yr %>% kable(caption= "Casual partners last year") %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Casual partners last year

mod.casl	nobs	n.wtd	prop.wtd
0	316	308.8	0.37
1	256	254.6	0.31
2	121	124.0	0.15
3	68	70.8	0.09
4	57	58.3	0.07
5	14	15.5	0.02

Age

tempDF <- egos %>%
  group_by(mod.casl, age.grp) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  group_by(age.grp) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

age.yr <- tempDF

Plot

p <- ggplot(tempDF, 
            aes(x=factor(mod.casl), y=prop.wtd,
                group = age.grp, fill = factor(age.grp),
                text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(alpha = 0.7, stat = "identity", position = "dodge") +
  labs(title = "Casual partners last year",
       x = "count",
       y = "wtd proportion",
       fill = "age group") +
  scale_fill_brewer() +
  theme_bw()

ggplotly(p, tooltip = "text")

Table

sjPlot::tab_xtab(var.row = egos$mod.casl, 
                 var.col = egos$age.grp, 
                 weight.by = egos$ego.wawt,
                 title = "Casual partners last year by age group",
                 show.col.prc = T,
                 show.summary = F)

Casual partners last year by age group

mod.casl	age.grp					Total
	1	2	3	4	5
0	77 53.5 %	103 48.6 %	46 26 %	44 28.8 %	39 26.7 %	309 37.1 %
1	40 27.8 %	56 26.4 %	60 33.9 %	56 36.6 %	43 29.5 %	255 30.6 %
2	16 11.1 %	29 13.7 %	24 13.6 %	24 15.7 %	30 20.5 %	123 14.8 %
3	5 3.5 %	15 7.1 %	25 14.1 %	14 9.2 %	12 8.2 %	71 8.5 %
4	6 4.2 %	7 3.3 %	18 10.2 %	11 7.2 %	17 11.6 %	59 7.1 %
5	0 0 %	2 0.9 %	4 2.3 %	4 2.6 %	5 3.4 %	15 1.8 %
Total	144 100 %	212 100 %	177 100 %	153 100 %	146 100 %	832 100 %

---

Race

tempDF <- egos %>%
  group_by(mod.casl, race) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  group_by(race) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

race.yr <- tempDF

Plot

p <- ggplot(tempDF, 
            aes(x=factor(mod.casl), y=prop.wtd, 
                group = race, fill = factor(race),
                text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(alpha = 0.7, 
           stat = "identity", 
           position = "dodge") +
  labs(title = "Casual partners last year",
       x = "count",
       y = "wtd proportion",
       fill = "race") 

ggplotly(p, tooltip = "text")

Table

sjPlot::tab_xtab(var.row = egos$mod.casl, 
                 var.col = egos$race, 
                 weight.by = egos$ego.wawt,
                 title = "Casual partners last year by age group",
                 show.col.prc = T,
                 show.summary = F)

Casual partners last year by age group

mod.casl	race			Total
	B	H	O
0	17 30.4 %	35 37.6 %	257 37.6 %	309 37.1 %
1	8 14.3 %	29 31.2 %	217 31.7 %	254 30.5 %
2	10 17.9 %	18 19.4 %	97 14.2 %	125 15 %
3	9 16.1 %	5 5.4 %	57 8.3 %	71 8.5 %
4	7 12.5 %	6 6.5 %	45 6.6 %	58 7 %
5	5 8.9 %	0 0 %	11 1.6 %	16 1.9 %
Total	56 100 %	93 100 %	684 100 %	833 100 %

---

Region

tempDF <- egos %>%
  group_by(mod.casl, region) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  group_by(region) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

region.yr <- tempDF

Plot

p <- ggplot(tempDF, 
            aes(x=factor(mod.casl), y=prop.wtd, 
                group = region, fill = factor(region),
                text = scales::percent(prop.wtd, acc = .1))) +
  geom_bar(alpha = 0.7, 
           stat = "identity", 
           position = "dodge") +
  labs(title = "Casual partners last year",
       x = "count",
       y = "wtd proportion",
       fill = "region") 

ggplotly(p, tooltip = "text")

Table

sjPlot::tab_xtab(var.row = egos$mod.casl, 
                 var.col = egos$region, 
                 weight.by = egos$ego.wawt,
                 title = "Casual partners last year by region",
                 show.col.prc = T,
                 show.summary = F)

Casual partners last year by region

mod.casl	region			Total
	EasternWA	King	WesternWA
0	35 42.7 %	172 36.5 %	103 36.9 %	310 37.3 %
1	21 25.6 %	157 33.3 %	76 27.2 %	254 30.5 %
2	13 15.9 %	74 15.7 %	37 13.3 %	124 14.9 %
3	6 7.3 %	42 8.9 %	23 8.2 %	71 8.5 %
4	6 7.3 %	21 4.5 %	31 11.1 %	58 7 %
5	1 1.2 %	5 1.1 %	9 3.2 %	15 1.8 %
Total	82 100 %	471 100 %	279 100 %	832 100 %

caslyr <- list(all = casl.yr,
              age = age.yr,
              race = race.yr,
              region = region.yr)

---

Onetime partners

Like snap, this is a long-tailed distribution. So the output target table for the discrete counts will have the tail truncated at 20+. But for the table of summary stats (mean, sd) and graphs here we will use the full distribution.

egos <- egos %>% mutate(ot20 = ifelse(count.oo.part <20, 
                                      count.oo.part, 20))

Overall

Plot

p <- ggplot(egos %>%
              mutate(num = count.oo.part+1), 
            aes(x=num, weight = ego.wawt)) +
  geom_density(fill = "blue", alpha = 0.5) +
  labs(title = "Annual number of one-time partners",
       x = "number (log scale)",
       y = "wtd density") + 
  scale_x_continuous(trans='log2')

ggplotly(p)

Summary table

egos %>%
  select(count.oo.part, ego.id, ego.wawt) %>%
  survey::svydesign(id = ~ego.id, data = ., weights = ~ego.wawt) %>%
  gtsummary::tbl_svysummary(
    #by = trt,
    type = list(count.oo.part ~ "continuous2"),
    statistic = list(count.oo.part ~ c("{N_miss} ({p_miss})",
                                       "{mean} ({sd})",
                                       "{median} ({p25}, {p75})",
                                       "{p90}",
                                       "{min}, {max}")),
    missing = "ifany"
  ) %>%
  gtsummary::as_gt()

Characteristic	N = 832
count.oo.part
N missing (% missing)	0 (0)
Mean (SD)	5 (12)
Median (IQR)	1 (0, 4)
90%	14
Range	0, 120

Count table

inst.yr <- egos %>%
  group_by(ot20) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

inst.yr %>% kable(caption= "Total onetime partner count (topcoded at 20+") %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Total onetime partner count (topcoded at 20+

ot20	nobs	n.wtd	prop.wtd
0	382	380.8	0.46
1	118	125.7	0.15
2	54	50.8	0.06
3	57	54.9	0.07
4	24	24.0	0.03
5	19	18.9	0.02
6	18	17.9	0.02
7	18	17.3	0.02
8	12	11.9	0.01
9	10	9.9	0.01
10	13	12.2	0.01
11	7	6.6	0.01
12	6	6.3	0.01
13	5	5.2	0.01
14	7	8.1	0.01
15	2	3.1	0.00
16	2	2.3	0.00
17	6	5.5	0.01
18	10	9.7	0.01
19	2	2.1	0.00
20	60	58.8	0.07

Age

Plot

p <- ggplot(egos %>%
              mutate(num = count.oo.part+1), 
            aes(x=num, weight = ego.wawt,
                group = age.grp, fill = factor(age.grp),
                text = age.grp)) +
  geom_density(alpha = 0.5) +
  labs(title = "Annual number of one-time partners",
       x = "number (log scale)",
       y = "wtd density") + 
  scale_x_continuous(trans='log2')
  

ggplotly(p, tooltip = "text")

Summary Table

egos %>%
  select(count.oo.part, age.grp, ego.id, ego.wawt) %>%
  survey::svydesign(id = ~ego.id, data = ., weights = ~ego.wawt) %>%
  gtsummary::tbl_svysummary(
    by = age.grp,
    type = list(count.oo.part ~ "continuous2"),
    statistic = list(count.oo.part ~ c("{N_nonmiss} ({p_miss})",
                                       "{mean} ({sd})",
                                       "{median} ({p25}, {p75})",
                                       "{p90}",
                                       "{min}, {max}")),
    missing = "ifany"
  ) %>%
  gtsummary::modify_header(label = " ", 
                           stat_by = "**{level}**") %>%
  gtsummary::as_kable_extra(caption = "Stats by age") %>%
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Stats by age

	1	2	3	4	5
count.oo.part
N (% missing)	144 (0)	212 (0)	177 (0)	153 (0)	147 (0)
Mean (SD)	2 (6)	6 (12)	6 (15)	5 (10)	5 (14)
Median (IQR)	1 (0, 2)	1 (0, 4)	1 (0, 5)	1 (0, 5)	1 (0, 5)
90%	5	18	18	16	10
Range	0, 43	0, 79	0, 120	0, 49	0, 115

Count table

age.yr <- egos %>%
  group_by(ot20, age.grp) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

## `summarise()` has grouped output by 'ot20'. You can override using the `.groups` argument.

age.yr %>% kable(caption= "Total onetime partner count (topcoded at 20+") %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Total onetime partner count (topcoded at 20+

ot20	age.grp	nobs	n.wtd	prop.wtd
0	1	65	69.7	0.18
0	2	116	96.6	0.25
0	3	77	80.9	0.21
0	4	64	69.3	0.18
0	5	60	64.2	0.17
1	1	24	34.4	0.27
1	2	37	30.1	0.24
1	3	23	27.2	0.22
1	4	15	14.0	0.11
1	5	19	20.1	0.16
2	1	9	9.7	0.19
2	2	19	15.7	0.31
2	3	8	6.9	0.14
2	4	11	10.8	0.21
2	5	7	7.6	0.15
3	1	8	8.0	0.15
3	2	13	11.4	0.21
3	3	11	9.6	0.18
3	4	9	8.9	0.16
3	5	16	16.9	0.31
4	1	3	3.0	0.12
4	2	8	7.5	0.31
4	3	6	6.1	0.25
4	4	7	7.4	0.31
5	1	4	4.0	0.21
5	2	3	2.6	0.14
5	3	5	4.0	0.21
5	4	4	4.9	0.26
5	5	3	3.4	0.18
6	1	1	1.3	0.07
6	2	4	3.6	0.20
6	3	5	4.4	0.25
6	4	2	1.8	0.10
6	5	6	6.8	0.38
7	1	1	1.4	0.08
7	2	6	4.4	0.26
7	3	4	4.0	0.23
7	4	4	4.0	0.23
7	5	3	3.4	0.20
8	1	1	0.7	0.06
8	2	3	2.3	0.19
8	3	2	2.3	0.19
8	4	3	3.7	0.31
8	5	3	2.9	0.24
9	1	2	2.1	0.21
9	2	2	1.6	0.16
9	3	1	1.1	0.11
9	4	2	2.1	0.21
9	5	3	3.0	0.30
10	2	6	4.7	0.39
10	3	2	2.0	0.16
10	4	1	0.9	0.07
10	5	4	4.6	0.38
11	2	1	1.0	0.15
11	3	1	0.9	0.13
11	4	4	3.9	0.58
11	5	1	0.9	0.13
12	1	1	1.4	0.23
12	2	2	2.0	0.32
12	4	3	2.8	0.45
13	1	1	1.4	0.27
13	2	1	0.7	0.13
13	3	2	2.4	0.46
13	5	1	0.7	0.13
14	1	1	1.4	0.17
14	2	1	0.6	0.07
14	3	2	2.8	0.35
14	4	1	1.0	0.12
14	5	2	2.2	0.28
15	3	1	1.1	0.37
15	4	1	1.9	0.63
16	3	2	2.3	1.00
17	1	1	1.0	0.18
17	2	2	1.7	0.30
17	4	2	1.9	0.34
17	5	1	1.0	0.18
18	1	1	1.4	0.14
18	2	5	4.1	0.42
18	3	2	2.3	0.24
18	4	1	0.9	0.09
18	5	1	1.0	0.10
19	4	2	2.1	1.00
20	1	3	2.6	0.04
20	2	23	21.0	0.36
20	3	15	16.4	0.28
20	4	11	10.7	0.18
20	5	8	8.1	0.14

Race

Plot

p <- ggplot(egos %>%
              mutate(num = count.oo.part+1), 
            aes(x=num, weight = ego.wawt,
                 group = race, fill = factor(race),
                 text = race)) +
  geom_density(alpha = 0.5) +
  labs(title = "Annual number of one-time partners",
       x = "number (log scale)",
       y = "wtd density",
       fill = "race") + 
  scale_x_continuous(trans='log2') 
  

ggplotly(p, tooltip = "text")

Summary Table

egos %>%
  select(count.oo.part, race, ego.id, ego.wawt) %>%
  survey::svydesign(id = ~ego.id, data = ., weights = ~ego.wawt) %>%
  gtsummary::tbl_svysummary(
    by = race,
    type = list(count.oo.part ~ "continuous2"),
    statistic = list(count.oo.part ~ c("{N_nonmiss} ({p_miss})",
                                       "{mean} ({sd})",
                                       "{median} ({p25}, {p75})",
                                       "{p90}",
                                       "{min}, {max}")),
    missing = "ifany"
  ) %>%
  gtsummary::modify_header(label = " ", 
                           stat_by = "**{level}**") %>%
  gtsummary::as_kable_extra(caption = "Stats by race") %>%
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Stats by race

	B	H	O
count.oo.part
N (% missing)	56 (0)	93 (0)	683 (0)
Mean (SD)	6 (13)	4 (8)	5 (12)
Median (IQR)	1 (0, 4)	1 (0, 3)	1 (0, 4)
90%	14	13	14
Range	0, 68	0, 43	0, 120

Count table

race.yr <- egos %>%
  group_by(ot20, race) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

## `summarise()` has grouped output by 'ot20'. You can override using the `.groups` argument.

race.yr %>% kable(caption= "Total onetime partner count (topcoded at 20+") %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Total onetime partner count (topcoded at 20+

ot20	race	nobs	n.wtd	prop.wtd
0	B	10	18.3	0.05
0	H	40	40.6	0.11
0	O	332	321.9	0.85
1	B	5	18.9	0.15
1	H	15	15.1	0.12
1	O	98	91.8	0.73
2	H	6	5.0	0.10
2	O	48	45.7	0.90
3	B	4	3.8	0.07
3	H	10	9.8	0.18
3	O	43	41.3	0.75
4	B	3	3.9	0.16
4	H	1	0.6	0.02
4	O	20	19.5	0.81
5	B	1	1.9	0.10
5	H	4	4.1	0.22
5	O	14	12.9	0.68
6	H	3	3.7	0.21
6	O	15	14.2	0.79
7	H	1	0.8	0.05
7	O	17	16.5	0.95
8	B	1	1.6	0.13
8	H	1	0.7	0.06
8	O	10	9.6	0.81
9	H	1	0.6	0.06
9	O	9	9.3	0.94
10	H	1	0.8	0.07
10	O	12	11.4	0.93
11	O	7	6.6	1.00
12	B	1	1.1	0.17
12	O	5	5.2	0.83
13	H	2	1.9	0.37
13	O	3	3.2	0.63
14	H	2	2.3	0.28
14	O	5	5.8	0.72
15	B	1	1.9	0.63
15	O	1	1.1	0.37
16	O	2	2.3	1.00
17	O	6	5.5	1.00
18	H	2	1.5	0.15
18	O	8	8.2	0.85
19	O	2	2.1	1.00
20	B	4	4.7	0.08
20	H	5	5.3	0.09
20	O	51	48.9	0.83

---

Region

Plot

p <- ggplot(egos %>%
              mutate(num = count.oo.part+1), 
            aes(x=num, weight = ego.wawt,
                group = region, fill = factor(region),
                text = region)) +
  geom_density(alpha = 0.5) +
  labs(title = "Annual number of one-time partners",
       x = "number (log scale)",
       y = "wtd density",
       fill = "region") + 
  scale_x_continuous(trans='log2') 
  

ggplotly(p, tooltip = "text")

Summary Table

egos %>%
  select(count.oo.part, region, ego.id, ego.wawt) %>%
  survey::svydesign(id = ~ego.id, data = ., weights = ~ego.wawt) %>%
  gtsummary::tbl_svysummary(
    by = region,
    type = list(count.oo.part ~ "continuous2"),
    statistic = list(count.oo.part ~ c("{N_nonmiss} ({p_miss})",
                                       "{mean} ({sd})",
                                       "{median} ({p25}, {p75})",
                                       "{p90}",
                                       "{min}, {max}")),
    missing = "ifany"
  ) %>%
  gtsummary::modify_header(label = " ", 
                           stat_by = "**{level}**") %>%
  gtsummary::as_kable_extra(caption = "Stats by region") %>%
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Stats by region

	EasternWA	King	WesternWA
count.oo.part
N (% missing)	83 (0)	472 (0)	277 (0)
Mean (SD)	3 (7)	5 (12)	5 (13)
Median (IQR)	1 (0, 3)	1 (0, 5)	1 (0, 3)
90%	9	16	13
Range	0, 34	0, 120	0, 115

Count table

region.yr <- egos %>%
  group_by(ot20, region) %>%
  summarise(nobs = n(),
            n.wtd = round(sum(ego.wawt), 1)) %>%
  mutate(prop.wtd = round(n.wtd / sum(n.wtd), 2))

## `summarise()` has grouped output by 'ot20'. You can override using the `.groups` argument.

region.yr %>% kable(caption= "Total onetime partner count (topcoded at 20+") %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Total onetime partner count (topcoded at 20+

ot20	region	nobs	n.wtd	prop.wtd
0	EasternWA	49	38.1	0.10
0	King	189	218.0	0.57
0	WesternWA	144	124.7	0.33
1	EasternWA	16	12.8	0.10
1	King	49	65.7	0.52
1	WesternWA	53	47.2	0.38
2	EasternWA	5	3.6	0.07
2	King	25	27.3	0.54
2	WesternWA	24	19.8	0.39
3	EasternWA	12	9.9	0.18
3	King	24	26.6	0.48
3	WesternWA	21	18.4	0.34
4	EasternWA	2	1.3	0.05
4	King	13	14.3	0.60
4	WesternWA	9	8.4	0.35
5	EasternWA	4	2.6	0.14
5	King	11	12.8	0.68
5	WesternWA	4	3.5	0.19
6	EasternWA	4	3.1	0.17
6	King	8	9.2	0.51
6	WesternWA	6	5.6	0.31
7	EasternWA	1	0.6	0.03
7	King	11	12.1	0.70
7	WesternWA	6	4.6	0.27
8	EasternWA	2	1.7	0.14
8	King	6	6.5	0.55
8	WesternWA	4	3.7	0.31
9	EasternWA	1	0.7	0.07
9	King	5	5.6	0.57
9	WesternWA	4	3.6	0.36
10	EasternWA	1	0.7	0.06
10	King	7	7.4	0.61
10	WesternWA	5	4.1	0.34
11	EasternWA	1	0.9	0.13
11	King	3	3.1	0.46
11	WesternWA	3	2.7	0.40
12	King	3	3.4	0.55
12	WesternWA	3	2.8	0.45
13	King	2	2.6	0.50
13	WesternWA	3	2.6	0.50
14	EasternWA	1	1.7	0.21
14	King	4	4.8	0.59
14	WesternWA	2	1.6	0.20
15	King	2	3.1	1.00
16	King	2	2.3	1.00
17	EasternWA	1	0.7	0.13
17	King	2	2.0	0.36
17	WesternWA	3	2.8	0.51
18	King	7	7.2	0.73
18	WesternWA	3	2.6	0.27
19	King	2	2.1	1.00
20	EasternWA	5	4.3	0.07
20	King	34	35.7	0.61
20	WesternWA	21	18.8	0.32

instyr <- list(all = inst.yr,
               age = age.yr,
               race = race.yr,
               region = region.yr)

---

Construct and save output

Only the overall degree distributions (main & casl) and stats (one-time) will be saved as targets for now.

The attr breakdowns are stored as descriptives.

Targets

# Targets: degdist, npart.yr and meandeg saved in separate list components

## Active degree ----

deg.dists = list(tot = tot.deg,
                 main = main.deg,
                 casl = casl.deg,
                 inst = inst.wk,
                 xnet = xnet)
descTable <- 
  tibble(Params = names(deg.dists), 
         Description = c("Total active degree", 
                         "Main active degree",
                         "Casl active degree",
                         "Onetime partners/wk",
                         "Crossnet tables"),
         Method = c(rep("wtd observed stats", 5)),
         Levels = c(rep("overall", 5)))

deg.dists <- c(deg.dists, list(descTable = descTable))

## Cumulative partners ----

npart.yr = list(tot = tot.yr,
                main = main.yr,
                casl = casl.yr,
                inst = inst.yr)
descTable <- 
  tibble(Params = names(npart.yr), 
         Description = c("Total partners last yr", 
                         "Main partners last yr",
                         "Casl partners last yr",
                         "Onetime partners last yr"),
         Method = c(rep("wtd observed stats", 4)),
         Levels = c(rep("overall", 4)))

npart.yr <- c(npart.yr, list(descTable = descTable))


## Mean degree (created by script) ----

source("Scripts/makeMeanDegTargets.R")


## Combine ----
whamp.net.targets <- c(list(deg.dists = deg.dists),
                       list(npart.yr = npart.yr),
                       list(meandeg = meandeg),
                       list(makefile = "make_WhampNetTargets"),
                       list(datasource = "WHAMP + ARTnetWA"))

descTable <- 
  tibble(Params = names(whamp.net.targets), 
         Description = c("Active Deg Distns",
                         "Partners last yr",
                         "Mean Active Degree",
                         whamp.net.targets$makefile,
                         whamp.net.targets$datasource),
         Method = c(rep("wtd observed stats", 3), 
                    rep(" ", 2)),
         Levels = c(rep("overall", 3), 
                    rep(" ", 2)))

whamp.net.targets <- c(whamp.net.targets, 
                       list(descTable = descTable))

saveRDS(whamp.net.targets,
        file = here::here("Data", "Targets", "WhampNetTargets.RDS"))

whamp.net.targets$descTable %>%
  kable(caption= "Sexual partner targets from WHAMP survey") %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Sexual partner targets from WHAMP survey

Params	Description	Method	Levels
deg.dists	Active Deg Distns	wtd observed stats	overall
npart.yr	Partners last yr	wtd observed stats	overall
meandeg	Mean Active Degree	wtd observed stats	overall
makefile	make_WhampNetTargets
datasource	WHAMP + ARTnetWA

whamp.net.targets$deg.dists$descTable %>%
  kable(caption= "Active degree distributions from WHAMP survey") %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Active degree distributions from WHAMP survey

Params	Description	Method	Levels
tot	Total active degree	wtd observed stats	overall
main	Main active degree	wtd observed stats	overall
casl	Casl active degree	wtd observed stats	overall
inst	Onetime partners/wk	wtd observed stats	overall
xnet	Crossnet tables	wtd observed stats	overall

whamp.net.targets$npart.yr$descTable %>%
  kable(caption= "Partners last yr from WHAMP survey") %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Partners last yr from WHAMP survey

Params	Description	Method	Levels
tot	Total partners last yr	wtd observed stats	overall
main	Main partners last yr	wtd observed stats	overall
casl	Casl partners last yr	wtd observed stats	overall
inst	Onetime partners last yr	wtd observed stats	overall

whamp.net.targets$meandeg$descTable %>%
  kable(caption= "Mean degree from WHAMP survey") %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Mean degree from WHAMP survey

Params	Description	Method
all	Mean degree by ptype	wtd observed stats
age	Mean degree by ptype	wtd observed stats
race	Mean degree by ptype	wtd observed stats
region	Mean degree by ptype	wtd observed stats
agexrace	Mean degree by ptype	wtd observed stats
agexregion	Mean degree by ptype	wtd observed stats
makefile	makeMeanDegTargets
datasource	WHAMP + ARTnetWA

print("Structure of output object:")

## [1] "Structure of output object:"

str(whamp.net.targets)

## List of 6
##  $ deg.dists :List of 6
##   ..$ tot      : tibble [6 x 4] (S3: tbl_df/tbl/data.frame)
##   .. ..$ deg.tot : num [1:6] 0 1 2 3 4 5
##   .. ..$ nobs    : int [1:6] 250 359 100 74 38 11
##   .. ..$ n.wtd   : num [1:6] 252.2 349.6 98.1 79.4 39.1 ...
##   .. ..$ prop.wtd: num [1:6] 0.3 0.42 0.12 0.1 0.05 0.02
##   ..$ main     : tibble [4 x 4] (S3: tbl_df/tbl/data.frame)
##   .. ..$ deg.main: num [1:4] 0 1 2 3
##   .. ..$ nobs    : int [1:4] 609 206 16 1
##   .. ..$ n.wtd   : num [1:4] 613.9 198.7 18.3 1.1
##   .. ..$ prop.wtd: num [1:4] 0.74 0.24 0.02 0
##   ..$ casl     : tibble [6 x 4] (S3: tbl_df/tbl/data.frame)
##   .. ..$ deg.casl: num [1:6] 0 1 2 3 4 5
##   .. ..$ nobs    : int [1:6] 398 250 90 63 27 4
##   .. ..$ n.wtd   : num [1:6] 391.4 250.5 91.3 65 27.6 ...
##   .. ..$ prop.wtd: num [1:6] 0.47 0.3 0.11 0.08 0.03 0.01
##   ..$ inst     : tibble [3 x 4] (S3: tbl_df/tbl/data.frame)
##   .. ..$ count.oo.wk: num [1:3] 0 1 2
##   .. ..$ nobs       : int [1:3] 788 39 5
##   .. ..$ n.wtd      : num [1:3] 788.5 38.5 5
##   .. ..$ prop.wtd   : num [1:3] 0.95 0.05 0.01
##   ..$ xnet     :List of 3
##   .. ..$ xnet.mc: grouped_df [16 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. .. ..$ deg.main: num [1:16] 0 0 0 0 0 0 1 1 1 1 ...
##   .. .. ..$ deg.casl: num [1:16] 0 1 2 3 4 5 0 1 2 3 ...
##   .. .. ..$ nobs    : int [1:16] 250 217 66 50 22 4 142 29 19 11 ...
##   .. .. ..$ n.wtd   : num [1:16] 252.2 216.3 64.9 51.9 22.4 ...
##   .. .. ..$ prop.wtd: num [1:16] 0.41 0.35 0.11 0.08 0.04 0.01 0.67 0.14 0.1 0.06 ...
##   .. .. ..- attr(*, "groups")= tibble [4 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. .. ..$ deg.main: num [1:4] 0 1 2 3
##   .. .. .. ..$ .rows   : list<int> [1:4] 
##   .. .. .. .. ..$ : int [1:6] 1 2 3 4 5 6
##   .. .. .. .. ..$ : int [1:5] 7 8 9 10 11
##   .. .. .. .. ..$ : int [1:4] 12 13 14 15
##   .. .. .. .. ..$ : int 16
##   .. .. .. .. ..@ ptype: int(0) 
##   .. .. .. ..- attr(*, ".drop")= logi TRUE
##   .. ..$ xnet.mi: grouped_df [9 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. .. ..$ deg.main   : num [1:9] 0 0 0 1 1 1 2 2 3
##   .. .. ..$ count.oo.wk: num [1:9] 0 1 2 0 1 2 0 1 1
##   .. .. ..$ nobs       : int [1:9] 579 26 4 196 9 1 13 3 1
##   .. .. ..$ n.wtd      : num [1:9] 585.9 24.2 3.8 188 9.5 ...
##   .. .. ..$ prop.wtd   : num [1:9] 0.95 0.04 0.01 0.95 0.05 0.01 0.8 0.2 1
##   .. .. ..- attr(*, "groups")= tibble [4 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. .. ..$ deg.main: num [1:4] 0 1 2 3
##   .. .. .. ..$ .rows   : list<int> [1:4] 
##   .. .. .. .. ..$ : int [1:3] 1 2 3
##   .. .. .. .. ..$ : int [1:3] 4 5 6
##   .. .. .. .. ..$ : int [1:2] 7 8
##   .. .. .. .. ..$ : int 9
##   .. .. .. .. ..@ ptype: int(0) 
##   .. .. .. ..- attr(*, ".drop")= logi TRUE
##   .. ..$ xnet.ci: grouped_df [15 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. .. ..$ deg.casl   : num [1:15] 0 0 1 1 1 2 2 3 3 4 ...
##   .. .. ..$ count.oo.wk: num [1:15] 0 1 0 1 2 0 1 0 1 0 ...
##   .. .. ..$ nobs       : int [1:15] 395 3 236 12 2 76 14 55 8 24 ...
##   .. .. ..$ n.wtd      : num [1:15] 388.6 2.8 235.9 12.8 1.8 ...
##   .. .. ..$ prop.wtd   : num [1:15] 0.99 0.01 0.94 0.05 0.01 0.85 0.15 0.89 0.11 0.88 ...
##   .. .. ..- attr(*, "groups")= tibble [6 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. .. ..$ deg.casl: num [1:6] 0 1 2 3 4 5
##   .. .. .. ..$ .rows   : list<int> [1:6] 
##   .. .. .. .. ..$ : int [1:2] 1 2
##   .. .. .. .. ..$ : int [1:3] 3 4 5
##   .. .. .. .. ..$ : int [1:2] 6 7
##   .. .. .. .. ..$ : int [1:2] 8 9
##   .. .. .. .. ..$ : int [1:3] 10 11 12
##   .. .. .. .. ..$ : int [1:3] 13 14 15
##   .. .. .. .. ..@ ptype: int(0) 
##   .. .. .. ..- attr(*, ".drop")= logi TRUE
##   ..$ descTable: tibble [5 x 4] (S3: tbl_df/tbl/data.frame)
##   .. ..$ Params     : chr [1:5] "tot" "main" "casl" "inst" ...
##   .. ..$ Description: chr [1:5] "Total active degree" "Main active degree" "Casl active degree" "Onetime partners/wk" ...
##   .. ..$ Method     : chr [1:5] "wtd observed stats" "wtd observed stats" "wtd observed stats" "wtd observed stats" ...
##   .. ..$ Levels     : chr [1:5] "overall" "overall" "overall" "overall" ...
##  $ npart.yr  :List of 5
##   ..$ tot      : tibble [18 x 4] (S3: tbl_df/tbl/data.frame)
##   .. ..$ snap20  : num [1:18] 0 1 2 3 4 5 6 7 8 9 ...
##   .. ..$ nobs    : int [1:18] 89 273 88 63 46 41 28 14 23 7 ...
##   .. ..$ n.wtd   : num [1:18] 86.4 274.5 83.9 65 48 ...
##   .. ..$ prop.wtd: num [1:18] 0.1 0.33 0.1 0.08 0.06 0.05 0.03 0.02 0.03 0.01 ...
##   ..$ main     :'data.frame':    6 obs. of  4 variables:
##   .. ..$ mod.main: num [1:6] 0 1 2 3 4 5
##   .. ..$ nobs    : num [1:6] 584 220 26 1 1 0
##   .. ..$ n.wtd   : num [1:6] 591.4 210.9 27.9 1.1 0.7 ...
##   .. ..$ prop.wtd: num [1:6] 0.71 0.25 0.03 0 0 0
##   ..$ casl     :'data.frame':    6 obs. of  4 variables:
##   .. ..$ mod.casl: num [1:6] 0 1 2 3 4 5
##   .. ..$ nobs    : int [1:6] 316 256 121 68 57 14
##   .. ..$ n.wtd   : num [1:6] 308.8 254.6 124 70.8 58.3 ...
##   .. ..$ prop.wtd: num [1:6] 0.37 0.31 0.15 0.09 0.07 0.02
##   ..$ inst     : tibble [21 x 4] (S3: tbl_df/tbl/data.frame)
##   .. ..$ ot20    : num [1:21] 0 1 2 3 4 5 6 7 8 9 ...
##   .. ..$ nobs    : int [1:21] 382 118 54 57 24 19 18 18 12 10 ...
##   .. ..$ n.wtd   : num [1:21] 380.8 125.7 50.8 54.9 24 ...
##   .. ..$ prop.wtd: num [1:21] 0.46 0.15 0.06 0.07 0.03 0.02 0.02 0.02 0.01 0.01 ...
##   ..$ descTable: tibble [4 x 4] (S3: tbl_df/tbl/data.frame)
##   .. ..$ Params     : chr [1:4] "tot" "main" "casl" "inst"
##   .. ..$ Description: chr [1:4] "Total partners last yr" "Main partners last yr" "Casl partners last yr" "Onetime partners last yr"
##   .. ..$ Method     : chr [1:4] "wtd observed stats" "wtd observed stats" "wtd observed stats" "wtd observed stats"
##   .. ..$ Levels     : chr [1:4] "overall" "overall" "overall" "overall"
##  $ meandeg   :List of 9
##   ..$ all       : tibble [6 x 9] (S3: tbl_df/tbl/data.frame)
##   .. ..$ var       : chr [1:6] "deg.main" "deg.casl" "deg.tot" "count.oo.wk" ...
##   .. ..$ nobs      : int [1:6] 832 832 832 832 832 832
##   .. ..$ n.valid   : int [1:6] 832 832 832 832 832 832
##   .. ..$ n.missing : int [1:6] 0 0 0 0 0 0
##   .. ..$ wtd.n     : num [1:6] 832 832 832 832 832 832
##   .. ..$ wtd.mean  : num [1:6] 0.2869 0.9249 1.2118 0.0582 6.6401 ...
##   .. ..$ wtd.sd    : num [1:6] 0.507 1.143 1.201 0.258 12.562 ...
##   .. ..$ wtd.semean: num [1:6] 0.01758 0.03962 0.04164 0.00896 0.4355 ...
##   .. ..$ wtd.median: Named num [1:6] 0 1 1 0 2 1
##   .. .. ..- attr(*, "names")= chr [1:6] "50%" "50%" "50%" "50%" ...
##   ..$ age       : tibble [30 x 10] (S3: tbl_df/tbl/data.frame)
##   .. ..$ age.grp   : num [1:30] 1 1 1 1 1 1 2 2 2 2 ...
##   .. ..$ var       : chr [1:30] "deg.main" "deg.casl" "deg.tot" "count.oo.wk" ...
##   .. ..$ nobs      : int [1:30] 126 126 126 126 126 126 252 252 252 252 ...
##   .. ..$ n.valid   : int [1:30] 126 126 126 126 126 126 252 252 252 252 ...
##   .. ..$ n.missing : int [1:30] 0 0 0 0 0 0 0 0 0 0 ...
##   .. ..$ wtd.n     : num [1:30] 144 144 144 144 144 ...
##   .. ..$ wtd.mean  : num [1:30] 0.2889 0.3649 0.6538 0.0135 3.5146 ...
##   .. ..$ wtd.sd    : num [1:30] 0.455 0.727 0.786 0.116 6.221 ...
##   .. ..$ wtd.semean: num [1:30] 0.03795 0.0607 0.06555 0.00967 0.51903 ...
##   .. ..$ wtd.median: Named num [1:30] 0 0 1 0 1 1 0 0 1 0 ...
##   .. .. ..- attr(*, "names")= chr [1:30] "50%" "50%" "50%" "50%" ...
##   ..$ race      : tibble [18 x 10] (S3: tbl_df/tbl/data.frame)
##   .. ..$ race      : chr [1:18] "B" "B" "B" "B" ...
##   .. ..$ var       : chr [1:18] "deg.main" "deg.casl" "deg.tot" "count.oo.wk" ...
##   .. ..$ nobs      : int [1:18] 30 30 30 30 30 30 94 94 94 94 ...
##   .. ..$ n.valid   : int [1:18] 30 30 30 30 30 30 94 94 94 94 ...
##   .. ..$ n.missing : int [1:18] 0 0 0 0 0 0 0 0 0 0 ...
##   .. ..$ wtd.n     : num [1:18] 56 56 56 56 56 ...
##   .. ..$ wtd.mean  : num [1:18] 0.2435 1.4073 1.6508 0.0833 7.7907 ...
##   .. ..$ wtd.sd    : num [1:18] 0.507 1.626 1.684 0.279 13.172 ...
##   .. ..$ wtd.semean: num [1:18] 0.0677 0.2173 0.2249 0.0372 1.7598 ...
##   .. ..$ wtd.median: Named num [1:18] 0 1 1 0 4 1 0 1 1 0 ...
##   .. .. ..- attr(*, "names")= chr [1:18] "50%" "50%" "50%" "50%" ...
##   ..$ region    : tibble [18 x 10] (S3: tbl_df/tbl/data.frame)
##   .. ..$ region    : chr [1:18] "EasternWA" "EasternWA" "EasternWA" "EasternWA" ...
##   .. ..$ var       : chr [1:18] "deg.main" "deg.casl" "deg.tot" "count.oo.wk" ...
##   .. ..$ nobs      : int [1:18] 105 105 105 105 105 105 409 409 409 409 ...
##   .. ..$ n.valid   : int [1:18] 105 105 105 105 105 105 409 409 409 409 ...
##   .. ..$ n.missing : int [1:18] 0 0 0 0 0 0 0 0 0 0 ...
##   .. ..$ wtd.n     : num [1:18] 82.6 82.6 82.6 82.6 82.6 ...
##   .. ..$ wtd.mean  : num [1:18] 0.3076 0.6878 0.9955 0.0357 4.9941 ...
##   .. ..$ wtd.sd    : num [1:18] 0.597 0.966 1.07 0.187 7.63 ...
##   .. ..$ wtd.semean: num [1:18] 0.0656 0.1063 0.1177 0.0205 0.8396 ...
##   .. ..$ wtd.median: Named num [1:18] 0 0 1 0 2 1 0 1 1 0 ...
##   .. .. ..- attr(*, "names")= chr [1:18] "50%" "50%" "50%" "50%" ...
##   ..$ agexrace  : tibble [84 x 11] (S3: tbl_df/tbl/data.frame)
##   .. ..$ age.grp   : num [1:84] 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ race      : chr [1:84] "B" "B" "B" "B" ...
##   .. ..$ var       : chr [1:84] "deg.main" "deg.casl" "deg.tot" "count.oo.wk" ...
##   .. ..$ nobs      : int [1:84] 1 1 1 1 1 1 24 24 24 24 ...
##   .. ..$ n.valid   : int [1:84] 1 1 1 1 1 1 24 24 24 24 ...
##   .. ..$ n.missing : int [1:84] 0 0 0 0 0 0 0 0 0 0 ...
##   .. ..$ wtd.n     : num [1:84] 9.03 9.03 9.03 9.03 9.03 ...
##   .. ..$ wtd.mean  : num [1:84] NA NA NA NA NA ...
##   .. ..$ wtd.sd    : num [1:84] NA NA NA NA NA ...
##   .. ..$ wtd.semean: num [1:84] NA NA NA NA NA ...
##   .. ..$ wtd.median: num [1:84] NA NA NA NA NA NA 0 0 1 0 ...
##   ..$ agexregion: tibble [90 x 11] (S3: tbl_df/tbl/data.frame)
##   .. ..$ age.grp   : num [1:90] 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ region    : chr [1:90] "EasternWA" "EasternWA" "EasternWA" "EasternWA" ...
##   .. ..$ var       : chr [1:90] "deg.main" "deg.casl" "deg.tot" "count.oo.wk" ...
##   .. ..$ nobs      : int [1:90] 24 24 24 24 24 24 49 49 49 49 ...
##   .. ..$ n.valid   : int [1:90] 24 24 24 24 24 24 49 49 49 49 ...
##   .. ..$ n.missing : int [1:90] 0 0 0 0 0 0 0 0 0 0 ...
##   .. ..$ wtd.n     : num [1:90] 19.2 19.2 19.2 19.2 19.2 ...
##   .. ..$ wtd.mean  : num [1:90] 0.3108 0.1723 0.4831 0.0346 3.9423 ...
##   .. ..$ wtd.sd    : num [1:90] 0.475 0.388 0.513 0.188 7.662 ...
##   .. ..$ wtd.semean: num [1:90] 0.1084 0.0884 0.117 0.0428 1.7465 ...
##   .. ..$ wtd.median: Named num [1:90] 0 0 1 0 1 1 0 0 0 0 ...
##   .. .. ..- attr(*, "names")= chr [1:90] "50%" "50%" "50%" "50%" ...
##   ..$ makefile  : chr "makeMeanDegTargets"
##   ..$ datasource: chr "WHAMP + ARTnetWA"
##   ..$ descTable : tibble [8 x 3] (S3: tbl_df/tbl/data.frame)
##   .. ..$ Params     : chr [1:8] "all" "age" "race" "region" ...
##   .. ..$ Description: chr [1:8] "Mean degree by ptype" "Mean degree by ptype" "Mean degree by ptype" "Mean degree by ptype" ...
##   .. ..$ Method     : chr [1:8] "wtd observed stats" "wtd observed stats" "wtd observed stats" "wtd observed stats" ...
##  $ makefile  : chr "make_WhampNetTargets"
##  $ datasource: chr "WHAMP + ARTnetWA"
##  $ descTable : tibble [5 x 4] (S3: tbl_df/tbl/data.frame)
##   ..$ Params     : chr [1:5] "deg.dists" "npart.yr" "meandeg" "makefile" ...
##   ..$ Description: chr [1:5] "Active Deg Distns" "Partners last yr" "Mean Active Degree" "make_WhampNetTargets" ...
##   ..$ Method     : chr [1:5] "wtd observed stats" "wtd observed stats" "wtd observed stats" " " ...
##   ..$ Levels     : chr [1:5] "overall" "overall" "overall" " " ...

Descriptives

We save the stratified degree distributions as descriptives due to small cell sizes.

# Descriptives

netstats = list(tot.deg = totdeg,
                main.deg = maindeg,
                casl.deg = casldeg,
                inst.wk = instwk,
                tot.yr = totyr,
                main.yr = mainyr,
                casl.yr = caslyr,
                inst.yr = instyr,
                makefile = "make_WhampNetTargets.Rmd")
descTable <- 
  tibble(Params = names(netstats), 
         Description = c("Total active degree", 
                         "Main active degree",
                         "Casl active degree",
                         "Onetime partners/wk",
                         "Total modules last yr", 
                         "Main in modules last yr",
                         "Casl in modules last yr",
                         "Onetime partners last yr",
                         "source file"),
         Method = c(rep("wtd observed stats", 8), " "),
         Levels = c(rep("overall, and by age, race, region", 8), " "))

whamp.netstats <- c(netstats, list(descTable = descTable))

saveRDS(whamp.netstats,
        file = here::here("Data", "Descriptives",
                          "WhampNetStats.RDS"))

descTable %>%
  kable(caption= "Netstats from WHAMP survey") %>% 
  kable_styling(full_width=F, position="center", 
                bootstrap_options = c("striped"))

Netstats from WHAMP survey

Params	Description	Method	Levels
tot.deg	Total active degree	wtd observed stats	overall, and by age, race, region
main.deg	Main active degree	wtd observed stats	overall, and by age, race, region
casl.deg	Casl active degree	wtd observed stats	overall, and by age, race, region
inst.wk	Onetime partners/wk	wtd observed stats	overall, and by age, race, region
tot.yr	Total modules last yr	wtd observed stats	overall, and by age, race, region
main.yr	Main in modules last yr	wtd observed stats	overall, and by age, race, region
casl.yr	Casl in modules last yr	wtd observed stats	overall, and by age, race, region
inst.yr	Onetime partners last yr	wtd observed stats	overall, and by age, race, region
makefile	source file

print("Structure of output object:")

## [1] "Structure of output object:"

str(whamp.netstats)

## List of 10
##  $ tot.deg  :List of 4
##   ..$ all   : tibble [6 x 4] (S3: tbl_df/tbl/data.frame)
##   .. ..$ deg.tot : num [1:6] 0 1 2 3 4 5
##   .. ..$ nobs    : int [1:6] 250 359 100 74 38 11
##   .. ..$ n.wtd   : num [1:6] 252.2 349.6 98.1 79.4 39.1 ...
##   .. ..$ prop.wtd: num [1:6] 0.3 0.42 0.12 0.1 0.05 0.02
##   ..$ age   : grouped_df [28 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ deg.tot : num [1:28] 0 0 0 0 0 1 1 1 1 1 ...
##   .. ..$ age.grp : num [1:28] 1 2 3 4 5 1 2 3 4 5 ...
##   .. ..$ nobs    : int [1:28] 54 80 40 40 36 64 107 78 64 46 ...
##   .. ..$ n.wtd   : num [1:28] 67 64.4 40.2 41.8 38.8 67.7 89.7 77.9 65.5 48.9 ...
##   .. ..$ prop.wtd: num [1:28] 0.47 0.3 0.23 0.27 0.26 0.47 0.42 0.44 0.43 0.33 ...
##   .. ..- attr(*, "groups")= tibble [5 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ age.grp: num [1:5] 1 2 3 4 5
##   .. .. ..$ .rows  : list<int> [1:5] 
##   .. .. .. ..$ : int [1:5] 1 6 11 16 21
##   .. .. .. ..$ : int [1:5] 2 7 12 17 22
##   .. .. .. ..$ : int [1:6] 3 8 13 18 23 26
##   .. .. .. ..$ : int [1:6] 4 9 14 19 24 27
##   .. .. .. ..$ : int [1:6] 5 10 15 20 25 28
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##   ..$ race  : grouped_df [18 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ deg.tot : num [1:18] 0 0 0 1 1 1 2 2 2 3 ...
##   .. ..$ race    : chr [1:18] "B" "H" "O" "B" ...
##   .. ..$ nobs    : int [1:18] 9 31 210 7 37 315 4 9 87 6 ...
##   .. ..$ n.wtd   : num [1:18] 21.9 32.5 197.7 8.3 34.4 ...
##   .. ..$ prop.wtd: num [1:18] 0.39 0.35 0.29 0.15 0.37 0.45 0.11 0.09 0.12 0.21 ...
##   .. ..- attr(*, "groups")= tibble [3 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ race : chr [1:3] "B" "H" "O"
##   .. .. ..$ .rows: list<int> [1:3] 
##   .. .. .. ..$ : int [1:6] 1 4 7 10 13 16
##   .. .. .. ..$ : int [1:6] 2 5 8 11 14 17
##   .. .. .. ..$ : int [1:6] 3 6 9 12 15 18
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##   ..$ region: grouped_df [18 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ deg.tot : num [1:18] 0 0 0 1 1 1 2 2 2 3 ...
##   .. ..$ region  : chr [1:18] "EasternWA" "King" "WesternWA" "EasternWA" ...
##   .. ..$ nobs    : int [1:18] 41 107 102 41 181 137 13 62 25 8 ...
##   .. ..$ n.wtd   : num [1:18] 31.9 135.3 85 31.5 201.4 ...
##   .. ..$ prop.wtd: num [1:18] 0.39 0.29 0.31 0.38 0.43 0.42 0.11 0.14 0.08 0.1 ...
##   .. ..- attr(*, "groups")= tibble [3 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ region: chr [1:3] "EasternWA" "King" "WesternWA"
##   .. .. ..$ .rows : list<int> [1:3] 
##   .. .. .. ..$ : int [1:6] 1 4 7 10 13 16
##   .. .. .. ..$ : int [1:6] 2 5 8 11 14 17
##   .. .. .. ..$ : int [1:6] 3 6 9 12 15 18
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##  $ main.deg :List of 4
##   ..$ all   : tibble [4 x 4] (S3: tbl_df/tbl/data.frame)
##   .. ..$ deg.main: num [1:4] 0 1 2 3
##   .. ..$ nobs    : int [1:4] 609 206 16 1
##   .. ..$ n.wtd   : num [1:4] 613.9 198.7 18.3 1.1
##   .. ..$ prop.wtd: num [1:4] 0.74 0.24 0.02 0
##   ..$ age   : grouped_df [15 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ deg.main: num [1:15] 0 0 0 0 0 1 1 1 1 1 ...
##   .. ..$ age.grp : num [1:15] 1 2 3 4 5 1 2 3 4 5 ...
##   .. ..$ nobs    : int [1:15] 86 161 127 121 114 40 86 35 24 21 ...
##   .. ..$ n.wtd   : num [1:15] 102 132 132 126 122 ...
##   .. ..$ prop.wtd: num [1:15] 0.71 0.62 0.75 0.82 0.83 0.29 0.36 0.2 0.16 0.15 ...
##   .. ..- attr(*, "groups")= tibble [5 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ age.grp: num [1:5] 1 2 3 4 5
##   .. .. ..$ .rows  : list<int> [1:5] 
##   .. .. .. ..$ : int [1:2] 1 6
##   .. .. .. ..$ : int [1:3] 2 7 11
##   .. .. .. ..$ : int [1:4] 3 8 12 15
##   .. .. .. ..$ : int [1:3] 4 9 13
##   .. .. .. ..$ : int [1:3] 5 10 14
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##   ..$ race  : grouped_df [10 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ deg.main: num [1:10] 0 0 0 1 1 1 2 2 2 3
##   .. ..$ race    : chr [1:10] "B" "H" "O" "B" ...
##   .. ..$ nobs    : int [1:10] 21 70 518 8 18 180 1 6 9 1
##   .. ..$ n.wtd   : num [1:10] 44.3 71.1 498.5 9.8 14.1 ...
##   .. ..$ prop.wtd: num [1:10] 0.79 0.77 0.73 0.18 0.15 0.26 0.03 0.08 0.01 0
##   .. ..- attr(*, "groups")= tibble [3 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ race : chr [1:3] "B" "H" "O"
##   .. .. ..$ .rows: list<int> [1:3] 
##   .. .. .. ..$ : int [1:3] 1 4 7
##   .. .. .. ..$ : int [1:3] 2 5 8
##   .. .. .. ..$ : int [1:4] 3 6 9 10
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##   ..$ region: grouped_df [10 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ deg.main: num [1:10] 0 0 0 1 1 1 2 2 2 3
##   .. ..$ region  : chr [1:10] "EasternWA" "King" "WesternWA" "EasternWA" ...
##   .. ..$ nobs    : int [1:10] 81 288 240 19 113 74 5 7 4 1
##   .. ..$ n.wtd   : num [1:10] 62.9 340.5 210.5 14 121.9 ...
##   .. ..$ prop.wtd: num [1:10] 0.76 0.72 0.76 0.17 0.26 0.23 0.07 0.02 0.01 0
##   .. ..- attr(*, "groups")= tibble [3 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ region: chr [1:3] "EasternWA" "King" "WesternWA"
##   .. .. ..$ .rows : list<int> [1:3] 
##   .. .. .. ..$ : int [1:3] 1 4 7
##   .. .. .. ..$ : int [1:4] 2 5 8 10
##   .. .. .. ..$ : int [1:3] 3 6 9
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##  $ casl.deg :List of 4
##   ..$ all   : tibble [6 x 4] (S3: tbl_df/tbl/data.frame)
##   .. ..$ deg.casl: num [1:6] 0 1 2 3 4 5
##   .. ..$ nobs    : int [1:6] 398 250 90 63 27 4
##   .. ..$ n.wtd   : num [1:6] 391.4 250.5 91.3 65 27.6 ...
##   .. ..$ prop.wtd: num [1:6] 0.47 0.3 0.11 0.08 0.03 0.01
##   ..$ age   : grouped_df [28 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ deg.casl: num [1:28] 0 0 0 0 0 1 1 1 1 1 ...
##   .. ..$ age.grp : num [1:28] 1 2 3 4 5 1 2 3 4 5 ...
##   .. ..$ nobs    : int [1:28] 91 145 64 55 43 28 60 63 54 45 ...
##   .. ..$ n.wtd   : num [1:28] 105.2 120.2 63.9 56.3 45.9 ...
##   .. ..$ prop.wtd: num [1:28] 0.73 0.57 0.36 0.37 0.31 0.21 0.24 0.37 0.37 0.33 ...
##   .. ..- attr(*, "groups")= tibble [5 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ age.grp: num [1:5] 1 2 3 4 5
##   .. .. ..$ .rows  : list<int> [1:5] 
##   .. .. .. ..$ : int [1:5] 1 6 11 16 21
##   .. .. .. ..$ : int [1:5] 2 7 12 17 22
##   .. .. .. ..$ : int [1:6] 3 8 13 18 23 26
##   .. .. .. ..$ : int [1:6] 4 9 14 19 24 27
##   .. .. .. ..$ : int [1:6] 5 10 15 20 25 28
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##   ..$ race  : grouped_df [17 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ deg.casl: num [1:17] 0 0 0 1 1 1 2 2 2 3 ...
##   .. ..$ race    : chr [1:17] "B" "H" "O" "B" ...
##   .. ..$ nobs    : int [1:17] 13 46 339 4 26 220 7 12 71 3 ...
##   .. ..$ n.wtd   : num [1:17] 26.2 44.4 320.7 5.2 27.9 ...
##   .. ..$ prop.wtd: num [1:17] 0.47 0.48 0.47 0.09 0.3 0.32 0.19 0.11 0.1 0.13 ...
##   .. ..- attr(*, "groups")= tibble [3 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ race : chr [1:3] "B" "H" "O"
##   .. .. ..$ .rows: list<int> [1:3] 
##   .. .. .. ..$ : int [1:6] 1 4 7 10 13 16
##   .. .. .. ..$ : int [1:5] 2 5 8 11 14
##   .. .. .. ..$ : int [1:6] 3 6 9 12 15 17
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##   ..$ region: grouped_df [17 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ deg.casl: num [1:17] 0 0 0 1 1 1 2 2 2 3 ...
##   .. ..$ region  : chr [1:17] "EasternWA" "King" "WesternWA" "EasternWA" ...
##   .. ..$ nobs    : int [1:17] 61 182 155 26 132 92 11 55 24 6 ...
##   .. ..$ n.wtd   : num [1:17] 46.3 215.9 129.1 22.6 148.2 ...
##   .. ..$ prop.wtd: num [1:17] 0.56 0.46 0.47 0.27 0.31 0.29 0.1 0.13 0.08 0.06 ...
##   .. ..- attr(*, "groups")= tibble [3 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ region: chr [1:3] "EasternWA" "King" "WesternWA"
##   .. .. ..$ .rows : list<int> [1:3] 
##   .. .. .. ..$ : int [1:5] 1 4 7 10 15
##   .. .. .. ..$ : int [1:6] 2 5 8 11 13 16
##   .. .. .. ..$ : int [1:6] 3 6 9 12 14 17
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##  $ inst.wk  :List of 4
##   ..$ all   : tibble [3 x 4] (S3: tbl_df/tbl/data.frame)
##   .. ..$ count.oo.wk: num [1:3] 0 1 2
##   .. ..$ nobs       : int [1:3] 788 39 5
##   .. ..$ n.wtd      : num [1:3] 788.5 38.5 5
##   .. ..$ prop.wtd   : num [1:3] 0.95 0.05 0.01
##   ..$ age   : grouped_df [13 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ count.oo.wk: num [1:13] 0 0 0 0 0 1 1 1 1 1 ...
##   .. ..$ age.grp    : num [1:13] 1 2 3 4 5 1 2 3 4 5 ...
##   .. ..$ nobs       : int [1:13] 124 234 158 139 133 2 17 9 8 3 ...
##   .. ..$ n.wtd      : num [1:13] 142 195 165 145 142 ...
##   .. ..$ prop.wtd   : num [1:13] 0.99 0.92 0.93 0.95 0.96 0.01 0.07 0.06 0.05 0.02 ...
##   .. ..- attr(*, "groups")= tibble [5 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ age.grp: num [1:5] 1 2 3 4 5
##   .. .. ..$ .rows  : list<int> [1:5] 
##   .. .. .. ..$ : int [1:2] 1 6
##   .. .. .. ..$ : int [1:3] 2 7 11
##   .. .. .. ..$ : int [1:3] 3 8 12
##   .. .. .. ..$ : int [1:2] 4 9
##   .. .. .. ..$ : int [1:3] 5 10 13
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##   ..$ race  : grouped_df [7 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ count.oo.wk: num [1:7] 0 0 0 1 1 1 2
##   .. ..$ race       : chr [1:7] "B" "H" "O" "B" ...
##   .. ..$ nobs       : int [1:7] 26 89 673 4 5 30 5
##   .. ..$ n.wtd      : num [1:7] 51.4 87.6 649.6 4.7 5.3 ...
##   .. ..$ prop.wtd   : num [1:7] 0.92 0.94 0.95 0.08 0.06 0.04 0.01
##   .. ..- attr(*, "groups")= tibble [3 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ race : chr [1:3] "B" "H" "O"
##   .. .. ..$ .rows: list<int> [1:3] 
##   .. .. .. ..$ : int [1:2] 1 4
##   .. .. .. ..$ : int [1:2] 2 5
##   .. .. .. ..$ : int [1:3] 3 6 7
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##   ..$ region: grouped_df [8 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ count.oo.wk: num [1:8] 0 0 0 1 1 1 2 2
##   .. ..$ region     : chr [1:8] "EasternWA" "King" "WesternWA" "EasternWA" ...
##   .. ..$ nobs       : int [1:8] 102 383 303 3 24 12 2 3
##   .. ..$ n.wtd      : num [1:8] 79.6 444.6 264.3 2.9 25.1 ...
##   .. ..$ prop.wtd   : num [1:8] 0.96 0.94 0.95 0.04 0.05 0.04 0 0.01
##   .. ..- attr(*, "groups")= tibble [3 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ region: chr [1:3] "EasternWA" "King" "WesternWA"
##   .. .. ..$ .rows : list<int> [1:3] 
##   .. .. .. ..$ : int [1:2] 1 4
##   .. .. .. ..$ : int [1:3] 2 5 7
##   .. .. .. ..$ : int [1:3] 3 6 8
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##  $ tot.yr   :List of 4
##   ..$ all   : tibble [18 x 4] (S3: tbl_df/tbl/data.frame)
##   .. ..$ snap20  : num [1:18] 0 1 2 3 4 5 6 7 8 9 ...
##   .. ..$ nobs    : int [1:18] 89 273 88 63 46 41 28 14 23 7 ...
##   .. ..$ n.wtd   : num [1:18] 86.4 274.5 83.9 65 48 ...
##   .. ..$ prop.wtd: num [1:18] 0.1 0.33 0.1 0.08 0.06 0.05 0.03 0.02 0.03 0.01 ...
##   ..$ age   : grouped_df [75 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ snap20  : num [1:75] 0 0 0 0 0 1 1 1 1 1 ...
##   .. ..$ age.grp : num [1:75] 1 2 3 4 5 1 2 3 4 5 ...
##   .. ..$ nobs    : int [1:75] 17 20 19 16 17 48 98 47 44 36 ...
##   .. ..$ n.wtd   : num [1:75] 17.7 14.8 18.1 17.7 18.2 58.4 82.6 48.5 46.2 38.8 ...
##   .. ..$ prop.wtd: num [1:75] 0.12 0.07 0.1 0.12 0.12 0.41 0.39 0.27 0.3 0.26 ...
##   .. ..- attr(*, "groups")= tibble [5 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ age.grp: num [1:5] 1 2 3 4 5
##   .. .. ..$ .rows  : list<int> [1:5] 
##   .. .. .. ..$ : int [1:14] 1 6 11 16 21 26 31 36 41 46 ...
##   .. .. .. ..$ : int [1:15] 2 7 12 17 22 27 32 37 42 47 ...
##   .. .. .. ..$ : int [1:17] 3 8 13 18 23 28 33 38 43 48 ...
##   .. .. .. ..$ : int [1:15] 4 9 14 19 24 29 34 39 44 53 ...
##   .. .. .. ..$ : int [1:14] 5 10 15 20 25 30 35 40 45 49 ...
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##   ..$ race  : grouped_df [43 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ snap20  : num [1:43] 0 0 1 1 1 2 2 2 3 3 ...
##   .. ..$ race    : chr [1:43] "H" "O" "B" "H" ...
##   .. ..$ nobs    : int [1:43] 7 82 7 32 234 2 10 76 2 13 ...
##   .. ..$ n.wtd   : num [1:43] 9.3 77.2 17.1 31.8 225.6 ...
##   .. ..$ prop.wtd: num [1:43] 0.1 0.11 0.3 0.34 0.33 0.04 0.09 0.11 0.11 0.13 ...
##   .. ..- attr(*, "groups")= tibble [3 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ race : chr [1:3] "B" "H" "O"
##   .. .. ..$ .rows: list<int> [1:3] 
##   .. .. .. ..$ : int [1:9] 3 6 9 12 15 22 30 34 41
##   .. .. .. ..$ : int [1:16] 1 4 7 10 13 16 18 20 23 25 ...
##   .. .. .. ..$ : int [1:18] 2 5 8 11 14 17 19 21 24 26 ...
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##   ..$ region: grouped_df [48 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ snap20  : num [1:48] 0 0 0 1 1 1 2 2 2 3 ...
##   .. ..$ region  : chr [1:48] "EasternWA" "King" "WesternWA" "EasternWA" ...
##   .. ..$ nobs    : int [1:48] 14 31 44 29 147 97 16 42 30 11 ...
##   .. ..$ n.wtd   : num [1:48] 10 38.7 37.7 24.4 169.4 ...
##   .. ..$ prop.wtd: num [1:48] 0.12 0.08 0.14 0.29 0.36 0.29 0.14 0.1 0.09 0.12 ...
##   .. ..- attr(*, "groups")= tibble [3 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ region: chr [1:3] "EasternWA" "King" "WesternWA"
##   .. .. ..$ .rows : list<int> [1:3] 
##   .. .. .. ..$ : int [1:15] 1 4 7 10 13 16 19 22 25 30 ...
##   .. .. .. ..$ : int [1:16] 2 5 8 11 14 17 20 23 26 28 ...
##   .. .. .. ..$ : int [1:17] 3 6 9 12 15 18 21 24 27 29 ...
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##  $ main.yr  :List of 4
##   ..$ all   :'data.frame':   6 obs. of  4 variables:
##   .. ..$ mod.main: num [1:6] 0 1 2 3 4 5
##   .. ..$ nobs    : num [1:6] 584 220 26 1 1 0
##   .. ..$ n.wtd   : num [1:6] 591.4 210.9 27.9 1.1 0.7 ...
##   .. ..$ prop.wtd: num [1:6] 0.71 0.25 0.03 0 0 0
##   ..$ age   : grouped_df [17 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ mod.main: num [1:17] 0 0 0 0 0 1 1 1 1 1 ...
##   .. ..$ age.grp : num [1:17] 1 2 3 4 5 1 2 3 4 5 ...
##   .. ..$ nobs    : int [1:17] 81 145 127 118 113 39 99 34 27 21 ...
##   .. ..$ n.wtd   : num [1:17] 96.7 118.3 132.1 123.3 121 ...
##   .. ..$ prop.wtd: num [1:17] 0.67 0.56 0.75 0.8 0.83 0.28 0.41 0.2 0.18 0.15 ...
##   .. ..- attr(*, "groups")= tibble [5 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ age.grp: num [1:5] 1 2 3 4 5
##   .. .. ..$ .rows  : list<int> [1:5] 
##   .. .. .. ..$ : int [1:3] 1 6 11
##   .. .. .. ..$ : int [1:4] 2 7 12 17
##   .. .. .. ..$ : int [1:4] 3 8 13 16
##   .. .. .. ..$ : int [1:3] 4 9 14
##   .. .. .. ..$ : int [1:3] 5 10 15
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##   ..$ race  : grouped_df [11 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ mod.main: num [1:11] 0 0 0 1 1 1 2 2 2 3 ...
##   .. ..$ race    : chr [1:11] "B" "H" "O" "B" ...
##   .. ..$ nobs    : int [1:11] 19 67 498 9 21 190 2 6 18 1 ...
##   .. ..$ n.wtd   : num [1:11] 41.9 68.8 480.7 11.4 16.5 ...
##   .. ..$ prop.wtd: num [1:11] 0.75 0.74 0.7 0.2 0.18 0.27 0.05 0.08 0.03 0 ...
##   .. ..- attr(*, "groups")= tibble [3 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ race : chr [1:3] "B" "H" "O"
##   .. .. ..$ .rows: list<int> [1:3] 
##   .. .. .. ..$ : int [1:3] 1 4 7
##   .. .. .. ..$ : int [1:3] 2 5 8
##   .. .. .. ..$ : int [1:5] 3 6 9 10 11
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##   ..$ region: grouped_df [11 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ mod.main: num [1:11] 0 0 0 1 1 1 2 2 2 3 ...
##   .. ..$ region  : chr [1:11] "EasternWA" "King" "WesternWA" "EasternWA" ...
##   .. ..$ nobs    : int [1:11] 76 279 229 21 119 80 7 10 9 1 ...
##   .. ..$ n.wtd   : num [1:11] 59.1 330.7 201.7 15.7 127.9 ...
##   .. ..$ prop.wtd: num [1:11] 0.72 0.7 0.73 0.19 0.27 0.24 0.09 0.03 0.03 0 ...
##   .. ..- attr(*, "groups")= tibble [3 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ region: chr [1:3] "EasternWA" "King" "WesternWA"
##   .. .. ..$ .rows : list<int> [1:3] 
##   .. .. .. ..$ : int [1:4] 1 4 7 11
##   .. .. .. ..$ : int [1:4] 2 5 8 10
##   .. .. .. ..$ : int [1:3] 3 6 9
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##  $ casl.yr  :List of 4
##   ..$ all   :'data.frame':   6 obs. of  4 variables:
##   .. ..$ mod.casl: num [1:6] 0 1 2 3 4 5
##   .. ..$ nobs    : int [1:6] 316 256 121 68 57 14
##   .. ..$ n.wtd   : num [1:6] 308.8 254.6 124 70.8 58.3 ...
##   .. ..$ prop.wtd: num [1:6] 0.37 0.31 0.15 0.09 0.07 0.02
##   ..$ age   : grouped_df [29 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ mod.casl: num [1:29] 0 0 0 0 0 1 1 1 1 1 ...
##   .. ..$ age.grp : num [1:29] 1 2 3 4 5 1 2 3 4 5 ...
##   .. ..$ nobs    : int [1:29] 66 123 48 43 36 37 67 60 52 40 ...
##   .. ..$ n.wtd   : num [1:29] 77.1 102.9 46.3 43.5 39 ...
##   .. ..$ prop.wtd: num [1:29] 0.54 0.49 0.26 0.28 0.27 0.28 0.26 0.34 0.37 0.29 ...
##   .. ..- attr(*, "groups")= tibble [5 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ age.grp: num [1:5] 1 2 3 4 5
##   .. .. ..$ .rows  : list<int> [1:5] 
##   .. .. .. ..$ : int [1:5] 1 6 11 16 21
##   .. .. .. ..$ : int [1:6] 2 7 12 17 22 26
##   .. .. .. ..$ : int [1:6] 3 8 13 18 23 27
##   .. .. .. ..$ : int [1:6] 4 9 14 19 24 28
##   .. .. .. ..$ : int [1:6] 5 10 15 20 25 29
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##   ..$ race  : grouped_df [17 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ mod.casl: num [1:17] 0 0 0 1 1 1 2 2 2 3 ...
##   .. ..$ race    : chr [1:17] "B" "H" "O" "B" ...
##   .. ..$ nobs    : int [1:17] 8 35 273 7 30 219 7 17 97 2 ...
##   .. ..$ n.wtd   : num [1:17] 17.2 34.5 257.1 8.3 29.4 ...
##   .. ..$ prop.wtd: num [1:17] 0.31 0.37 0.38 0.15 0.32 0.32 0.17 0.19 0.14 0.17 ...
##   .. ..- attr(*, "groups")= tibble [3 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ race : chr [1:3] "B" "H" "O"
##   .. .. ..$ .rows: list<int> [1:3] 
##   .. .. .. ..$ : int [1:6] 1 4 7 10 13 16
##   .. .. .. ..$ : int [1:5] 2 5 8 11 14
##   .. .. .. ..$ : int [1:6] 3 6 9 12 15 17
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##   ..$ region: grouped_df [18 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ mod.casl: num [1:18] 0 0 0 1 1 1 2 2 2 3 ...
##   .. ..$ region  : chr [1:18] "EasternWA" "King" "WesternWA" "EasternWA" ...
##   .. ..$ nobs    : int [1:18] 44 148 124 28 140 88 15 65 41 8 ...
##   .. ..$ n.wtd   : num [1:18] 34.6 171.7 102.6 21.5 157.3 ...
##   .. ..$ prop.wtd: num [1:18] 0.42 0.36 0.37 0.26 0.33 0.27 0.16 0.16 0.13 0.07 ...
##   .. ..- attr(*, "groups")= tibble [3 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ region: chr [1:3] "EasternWA" "King" "WesternWA"
##   .. .. ..$ .rows : list<int> [1:3] 
##   .. .. .. ..$ : int [1:6] 1 4 7 10 13 16
##   .. .. .. ..$ : int [1:6] 2 5 8 11 14 17
##   .. .. .. ..$ : int [1:6] 3 6 9 12 15 18
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##  $ inst.yr  :List of 4
##   ..$ all   : tibble [21 x 4] (S3: tbl_df/tbl/data.frame)
##   .. ..$ ot20    : num [1:21] 0 1 2 3 4 5 6 7 8 9 ...
##   .. ..$ nobs    : int [1:21] 382 118 54 57 24 19 18 18 12 10 ...
##   .. ..$ n.wtd   : num [1:21] 380.8 125.7 50.8 54.9 24 ...
##   .. ..$ prop.wtd: num [1:21] 0.46 0.15 0.06 0.07 0.03 0.02 0.02 0.02 0.01 0.01 ...
##   ..$ age   : grouped_df [87 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ ot20    : num [1:87] 0 0 0 0 0 1 1 1 1 1 ...
##   .. ..$ age.grp : num [1:87] 1 2 3 4 5 1 2 3 4 5 ...
##   .. ..$ nobs    : int [1:87] 65 116 77 64 60 24 37 23 15 19 ...
##   .. ..$ n.wtd   : num [1:87] 69.7 96.6 80.9 69.3 64.2 34.4 30.1 27.2 14 20.1 ...
##   .. ..$ prop.wtd: num [1:87] 0.18 0.25 0.21 0.18 0.17 0.27 0.24 0.22 0.11 0.16 ...
##   .. ..- attr(*, "groups")= tibble [21 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ ot20 : num [1:21] 0 1 2 3 4 5 6 7 8 9 ...
##   .. .. ..$ .rows: list<int> [1:21] 
##   .. .. .. ..$ : int [1:5] 1 2 3 4 5
##   .. .. .. ..$ : int [1:5] 6 7 8 9 10
##   .. .. .. ..$ : int [1:5] 11 12 13 14 15
##   .. .. .. ..$ : int [1:5] 16 17 18 19 20
##   .. .. .. ..$ : int [1:4] 21 22 23 24
##   .. .. .. ..$ : int [1:5] 25 26 27 28 29
##   .. .. .. ..$ : int [1:5] 30 31 32 33 34
##   .. .. .. ..$ : int [1:5] 35 36 37 38 39
##   .. .. .. ..$ : int [1:5] 40 41 42 43 44
##   .. .. .. ..$ : int [1:5] 45 46 47 48 49
##   .. .. .. ..$ : int [1:4] 50 51 52 53
##   .. .. .. ..$ : int [1:4] 54 55 56 57
##   .. .. .. ..$ : int [1:3] 58 59 60
##   .. .. .. ..$ : int [1:4] 61 62 63 64
##   .. .. .. ..$ : int [1:5] 65 66 67 68 69
##   .. .. .. ..$ : int [1:2] 70 71
##   .. .. .. ..$ : int 72
##   .. .. .. ..$ : int [1:4] 73 74 75 76
##   .. .. .. ..$ : int [1:5] 77 78 79 80 81
##   .. .. .. ..$ : int 82
##   .. .. .. ..$ : int [1:5] 83 84 85 86 87
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##   ..$ race  : grouped_df [45 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ ot20    : num [1:45] 0 0 0 1 1 1 2 2 3 3 ...
##   .. ..$ race    : chr [1:45] "B" "H" "O" "B" ...
##   .. ..$ nobs    : int [1:45] 10 40 332 5 15 98 6 48 4 10 ...
##   .. ..$ n.wtd   : num [1:45] 18.3 40.6 321.9 18.9 15.1 ...
##   .. ..$ prop.wtd: num [1:45] 0.05 0.11 0.85 0.15 0.12 0.73 0.1 0.9 0.07 0.18 ...
##   .. ..- attr(*, "groups")= tibble [21 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ ot20 : num [1:21] 0 1 2 3 4 5 6 7 8 9 ...
##   .. .. ..$ .rows: list<int> [1:21] 
##   .. .. .. ..$ : int [1:3] 1 2 3
##   .. .. .. ..$ : int [1:3] 4 5 6
##   .. .. .. ..$ : int [1:2] 7 8
##   .. .. .. ..$ : int [1:3] 9 10 11
##   .. .. .. ..$ : int [1:3] 12 13 14
##   .. .. .. ..$ : int [1:3] 15 16 17
##   .. .. .. ..$ : int [1:2] 18 19
##   .. .. .. ..$ : int [1:2] 20 21
##   .. .. .. ..$ : int [1:3] 22 23 24
##   .. .. .. ..$ : int [1:2] 25 26
##   .. .. .. ..$ : int [1:2] 27 28
##   .. .. .. ..$ : int 29
##   .. .. .. ..$ : int [1:2] 30 31
##   .. .. .. ..$ : int [1:2] 32 33
##   .. .. .. ..$ : int [1:2] 34 35
##   .. .. .. ..$ : int [1:2] 36 37
##   .. .. .. ..$ : int 38
##   .. .. .. ..$ : int 39
##   .. .. .. ..$ : int [1:2] 40 41
##   .. .. .. ..$ : int 42
##   .. .. .. ..$ : int [1:3] 43 44 45
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##   ..$ region: grouped_df [54 x 5] (S3: grouped_df/tbl_df/tbl/data.frame)
##   .. ..$ ot20    : num [1:54] 0 0 0 1 1 1 2 2 2 3 ...
##   .. ..$ region  : chr [1:54] "EasternWA" "King" "WesternWA" "EasternWA" ...
##   .. ..$ nobs    : int [1:54] 49 189 144 16 49 53 5 25 24 12 ...
##   .. ..$ n.wtd   : num [1:54] 38.1 218 124.7 12.8 65.7 ...
##   .. ..$ prop.wtd: num [1:54] 0.1 0.57 0.33 0.1 0.52 0.38 0.07 0.54 0.39 0.18 ...
##   .. ..- attr(*, "groups")= tibble [21 x 2] (S3: tbl_df/tbl/data.frame)
##   .. .. ..$ ot20 : num [1:21] 0 1 2 3 4 5 6 7 8 9 ...
##   .. .. ..$ .rows: list<int> [1:21] 
##   .. .. .. ..$ : int [1:3] 1 2 3
##   .. .. .. ..$ : int [1:3] 4 5 6
##   .. .. .. ..$ : int [1:3] 7 8 9
##   .. .. .. ..$ : int [1:3] 10 11 12
##   .. .. .. ..$ : int [1:3] 13 14 15
##   .. .. .. ..$ : int [1:3] 16 17 18
##   .. .. .. ..$ : int [1:3] 19 20 21
##   .. .. .. ..$ : int [1:3] 22 23 24
##   .. .. .. ..$ : int [1:3] 25 26 27
##   .. .. .. ..$ : int [1:3] 28 29 30
##   .. .. .. ..$ : int [1:3] 31 32 33
##   .. .. .. ..$ : int [1:3] 34 35 36
##   .. .. .. ..$ : int [1:2] 37 38
##   .. .. .. ..$ : int [1:2] 39 40
##   .. .. .. ..$ : int [1:3] 41 42 43
##   .. .. .. ..$ : int 44
##   .. .. .. ..$ : int 45
##   .. .. .. ..$ : int [1:3] 46 47 48
##   .. .. .. ..$ : int [1:2] 49 50
##   .. .. .. ..$ : int 51
##   .. .. .. ..$ : int [1:3] 52 53 54
##   .. .. .. ..@ ptype: int(0) 
##   .. .. ..- attr(*, ".drop")= logi TRUE
##  $ makefile : chr "make_WhampNetTargets.Rmd"
##  $ descTable: tibble [9 x 4] (S3: tbl_df/tbl/data.frame)
##   ..$ Params     : chr [1:9] "tot.deg" "main.deg" "casl.deg" "inst.wk" ...
##   ..$ Description: chr [1:9] "Total active degree" "Main active degree" "Casl active degree" "Onetime partners/wk" ...
##   ..$ Method     : chr [1:9] "wtd observed stats" "wtd observed stats" "wtd observed stats" "wtd observed stats" ...
##   ..$ Levels     : chr [1:9] "overall, and by age, race, region" "overall, and by age, race, region" "overall, and by age, race, region" "overall, and by age, race, region" ...