ABM Summary 2 April 2018

Bringing in data

Second round of data prepared by Narjes was put in SQLite and grabbed it here:

library(dplyr)
library(DBI)
library(ggplot2)
con <- dbConnect(RSQLite::SQLite(),  'DATA/abm1.sqlite')
dbListTables(con)

[1] "abm_m1"       "abm_m2"       "abm_m3"       "sqlite_stat1" "sqlite_stat4"

Data ‘a1’ is the generation-specific stress and LQ:

a1 <- tbl(con, 'abm_m3') %>%
  group_by(Generation, Age, Race) %>%
  summarize(mean_stress = mean(AverageStressScore),
            mean_LQ = mean(LQ)) %>%
  collect() %>%
  mutate(GEN = factor(Generation))
head(a1)

Life course stress trajectories

Checking generational similarity of life course stress trajectories by race and assuring that age-limits more reasonable – they look to be:

g <- ggplot(a1, aes(x=Age, y=mean_stress, group = GEN, 
                    color = GEN))
g + geom_smooth() + facet_grid(Race ~ .)

This looks different from past runs…there is larger racial disparity in accumulated stress and there is some evidence of trans-generational transfer of stress with increases especially for blacks, across generations. Both of these are in line with theoretical model; this probably reflects the class x race dependency added to initial population in latest round.

Now we are looking at Social Class x Generation to see if differences:

Less generational difference, but appearance of the divergence of accumulated stress by class.

Here I am limiting to middle generations (e.g. pooling generations 1-4) and looking at race x SES stratification

 a2 <- tbl(con, 'abm_m3') %>%
   filter(Generation %in% c(1,2,3,4)) %>%
   group_by(Race, SocialClass, Age) %>%
   summarize(mean_stress = mean(AverageStressScore),
             mean_LQ = mean(LQ)) %>%
  collect()

g <- ggplot(a2, aes(x=Age, y=mean_stress, group = SocialClass, 
                    color = SocialClass))
g + geom_smooth() +  facet_grid(Race ~ .) 

Life course LQ trajectories

Now following same process with mean LQ. First examining race x generation:

g <- ggplot(a1, aes(x=Age, y=mean_LQ, group = GEN, 
                    color = GEN))
g + geom_smooth() +  facet_grid(Race ~ .) 

Now examining LQ for SocialClass x generations:

g <- ggplot(a1b, aes(x=Age, y=mean_LQ, group = GEN, 
                    color = GEN))
g + geom_smooth() +  facet_grid(SocialClass ~ .) 

g <- ggplot(a2, aes(x=Age, y=mean_LQ, group = SocialClass, 
                    color = SocialClass))
g + geom_smooth() +  facet_grid(Race ~ .) 

SUMMARY OF ABOVE: There is still a strong trans-generational shift to lower LQ among Blacks which is not entirely realistic but pooling generations 2-4 and looking at race x class, the patterns appear reasonable…some racial disparity within class but larger class disparity.

Birth Rates

Based on skype with Allen & Narjes (3/30/18), I learned that the variable ‘GestationalAge’ is coded like this:

• 36 = Preterm
• 38 = Term
• 100 = Not pregnant

a3 <- tbl(con, 'abm_m3') %>%
  filter(Generation %in% c(1,2,3,4,5)) %>%
  mutate(Pregnant = ifelse(GestationalAge == 100, 0, 1)) %>%
  group_by(Age, Race, SocialClass) %>%
  summarize(CBR = mean(Pregnant)) %>%
  collect()
# CBR by race
g <- ggplot(a3, aes(x = Age, y = CBR, group = Race, color = Race))
g + geom_smooth() + scale_x_continuous(limits = c(13,50)) + scale_y_continuous(limits = c(0, .15))

# CBR by class
g <- ggplot(a3, aes(x = Age, y = CBR, group = SocialClass, color = SocialClass))
g + geom_smooth() + scale_x_continuous(limits = c(13,50)) + scale_y_continuous(limits = c(0, .15))

a3b <- tbl(con, 'abm_m3') %>%
  filter(Generation %in% c(1,2,3,4,5),
         Parity %in% c(0,1,2,3,4)) %>%
  mutate(Pregnant = ifelse(GestationalAge == 100, 0, 1)) %>%
  group_by(Age, Race, Parity) %>%
  summarize(CBR = mean(Pregnant)) %>%
  collect()
# CBR by Parity (stratify on Race)
g <- ggplot(a3b, aes(x = Age, y = CBR, group = factor(Parity), color = factor(Parity)))
g + geom_smooth() + facet_grid(.~Race) +
  scale_x_continuous(limits = c(13,50)) + scale_y_continuous(limits = c(0, .15))

Pregnancy Outcomes

Now I am interested in age-specific birth rate and the risk for Preterm Birth (PTB; <37 weeks).

a4 <- tbl(con, 'abm_m3') %>%
  filter(Generation %in% c(1,2,3,4,5),
         GestationalAge != 100) %>%
  mutate(PTB = ifelse(GestationalAge == 36, 1, 0)) %>%
  group_by(Race, SocialClass, Age) %>%
  summarise(PTBr = mean(PTB, na.rm = T)) %>%
  collect()
g <- ggplot(a4, aes(x = Age, y = PTBr, group = Race, color = Race))
g + geom_smooth()

g <- ggplot(a4, aes(x = Age, y = PTBr, group = SocialClass, color = SocialClass))
g + geom_smooth()

Something in calculation of Preterm Birth is inverted…white women and high SES women have high risk and Black and Low SES women have zero or low risk.