Parenting behaviors
Emily
2017-03-25
1 Data preprocessing
Preliminaries.
## [1] "dplyr" "langcog" "tidyr" "ggplot2" "lme4"##
## Attaching package: 'langcog'## The following object is masked from 'package:base':
##
## scale## Loading tidyverse: ggplot2
## Loading tidyverse: tibble
## Loading tidyverse: tidyr
## Loading tidyverse: readr
## Loading tidyverse: purrr
## Loading tidyverse: dplyr## Conflicts with tidy packages ----------------------------------------------## %+%(): ggplot2, psych
## alpha(): ggplot2, psych
## filter(): dplyr, stats
## lag(): dplyr, stats##
## Attaching package: 'ggthemes'## The following objects are masked from 'package:langcog':
##
## scale_color_solarized, scale_colour_solarized,
## scale_fill_solarized## Loading required package: Matrix##
## Attaching package: 'Matrix'## The following object is masked from 'package:tidyr':
##
## expand##
## Attaching package: 'lmerTest'## The following object is masked from 'package:lme4':
##
## lmer## The following object is masked from 'package:stats':
##
## stepRead in participant data.
files <- dir("../production-results/parenting_behaviors_e2/")
attitudes <- data.frame()
behaviors <- data.frame()
subinfo <- data.frame()
for (f in files) {
jf <- paste("../production-results/parenting_behaviors_e2/",f,sep="")
jd <- fromJSON(paste(readLines(jf), collapse=""))
#paq answers
attitudes_id <- data.frame(sid = as.factor(jd$WorkerId),
sent = jd$answers$data$sentence[1:24],
rating = as.numeric(jd$answers$data$rating[1:24]))
attitudes <- bind_rows(attitudes, attitudes_id)
#behaviors
behaviors_id <- data.frame(sid = as.factor(jd$WorkerId),
sent = jd$answers$data$sentence[25:36],
rating = as.numeric(jd$answers$data$rating[25:36]))
behaviors <- bind_rows(behaviors, behaviors_id)
#demographics
subinfo_id <- data.frame(sid = as.factor(jd$WorkerId),
behave_age = jd$answers$data$behaveAge,
children = jd$answers$data$children,
youngest = jd$answers$data$childAgeYoung,
oldest = jd$answers$data$childAgeOld,
ses = jd$answers$data$ladder,
gender = jd$answers$data$gender,
age = jd$answers$data$age,
education = jd$answers$data$education,
ethnicity = jd$answers$data$ethnicity,
race = as.character(jd$answers$data$race[1]),
comments = jd$answers$data$comments)
subinfo <- bind_rows(subinfo, subinfo_id)
}Read in trial info and questionnaire labels.
labels <- read.csv("sent_forms.csv")
labels$sent <- as.character(labels$sent)
behave <- read.csv("behaviors_e2.csv")Clean up labels.
attitudes$sent <- str_replace_all(as.character(attitudes$sent), "[â‘”“’']", "")
behaviors$sent <- str_replace_all(as.character(behaviors$sent), "[â‘”“’']", "")Make data frames.
dq <- attitudes %>%
left_join(labels)%>%
mutate(category_paq = category)%>%
select(-category)
db <- behaviors%>%
left_join(behave)%>%
mutate(category_bev = category)%>%
select(-category)
#remove items that parents marked as "my child is too young"
db$rating[db$rating == 0] <- NA
#rescore reverse coded items
dq$rating <- as.numeric(dq$rating)
dq$rating[dq$reverse_code == 1] <- 6 - dq$rating[dq$reverse_code == 1]Get means by category.
atts <- dq %>%
group_by(sid, category_paq) %>%
summarise(rating_paq = mean(rating))
bevs <- db %>%
group_by(sid, category_bev) %>%
summarise(rating_bev = mean(rating))
all <- atts %>%
left_join(bevs)%>%
left_join(subinfo)%>%
filter(!children == "0")2 Demographics
subinfo$education <- factor(subinfo$education,
levels = c("highSchool","someCollege","4year","someGrad","Grad"))
qplot(ses, data=subinfo)
qplot(children, data=subinfo)
qplot(gender, data=subinfo)
qplot(education, data=subinfo)
qplot(age, data=subinfo)
qplot(race, data=subinfo)
qplot(ethnicity, data=subinfo)
3 PAQ
Get mean ratings for sentences.
ms <- dq %>%
group_by(category_paq, short_sent, reverse_code) %>%
multi_boot_standard(col = "rating", na.rm = TRUE) %>%
arrange(category_paq, desc(mean))
ms$short_sent_ord <- factor(ms$short_sent,
levels = ms$short_sent)Plot responses to individual questionnaire items.
qplot(short_sent_ord, mean, col = category_paq,
ymin = ci_lower, ymax = ci_upper, pch = factor(reverse_code),
geom = "pointrange",
data = ms) +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = .5)) +
xlab("") +
ylab("Mean Rating") +
ylim(c(0,6)) +
scale_colour_solarized()
Plot mean subscale scores.
atts_m <- dq %>%
group_by(category_paq) %>%
multi_boot_standard(col = "rating", na.rm = TRUE) %>%
arrange(category_paq, desc(mean))
ggplot(atts_m, aes(x = category_paq, y = mean)) +
geom_bar(stat="identity") +
geom_linerange(aes(ymin = ci_lower, ymax = ci_upper),
position = position_dodge(width = .9))+
ylim(c(0,6)) 
4 Behaviors
Get mean ratings for behaviors.
ms_b <- db %>%
group_by(category_bev, short_sent) %>%
multi_boot_standard(col = "rating", na.rm = TRUE) %>%
arrange(category_bev, desc(mean))
ms_b$short_sent_ord <- factor(ms_b$short_sent,
levels = ms_b$short_sent)Recode variables for plotting.
bev <- behaviors %>%
left_join(behave)%>%
group_by(category)
bev$rating[bev$rating=="0"] <- "My child is too young"
bev$rating[bev$rating=="1"] <- "Never"
bev$rating[bev$rating=="2"] <- "Almost never"
bev$rating[bev$rating=="3"] <- "Occasionally"
bev$rating[bev$rating=="4"] <- "Once or twice per week"
bev$rating[bev$rating=="5"] <- "Most days"
bev$rating[bev$rating=="6"] <- "Multiple times ever day"
bev$rating <- factor(bev$rating, levels = c("My child is too young", "Never", "Almost never","Occasionally","Once or twice per week","Most days","Multiple times ever day"))
bev$short_sent <- factor(bev$short_sent, levels = c("read","practice numbers and letters","make observations", "educational programming","talk about feelings","spend time cuddling","sleep in the same bed","hug and kiss","talk sternly","give time out or punishments","talk about setting limits","help with chores"))
subinfo$behave_age[subinfo$behave_age == "0-6"] <- "0-6 months"
subinfo$behave_age[subinfo$behave_age == "7-12"] <- "7-12 months"
subinfo$behave_age <- factor(subinfo$behave_age, levels = c("0-6 months", "7-12 months", "1-1.5","1.5-2","2-2.5","2.5-3","3-3.5","3.5-4", "4-4.5","4.5-5", "older"))Plot mean frequency of individual behavior items. This treats frequency as a continuous variable which it really isn’t- is there a better way or does this seem okay?
Parents were asked to answer questions about their youngest child. How old is their youngest child?
qplot(behave_age, data=subinfo)
How frequent were individual behaviors?
qplot(short_sent_ord, mean, col = category_bev,
ymin = ci_lower, ymax = ci_upper,
geom = "pointrange",
data = ms_b) +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = .5)) +
xlab("") +
ylab("Frequency of Behavior") +
ylim(c(0,6)) +
scale_colour_solarized()
What do the means look like?
ggplot(bev, aes(short_sent, fill = rating, shape = category)) +
geom_bar(position = "fill")+
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = .5)) +
xlab("Behavior") +
ylab("Proportion responding") 
4.1 Reliability
Are behaviors within a category correlated with each other? This is relevant if we choose to use mean scores within these categories for subsequent analyses.
Rules and Respect
wide.bev <- db %>%
filter(category_bev == "RR") %>%
select(sid, short_sent, rating) %>%
spread(short_sent, rating)
alpha.rr <- as.matrix(select(wide.bev, -sid))
psych::alpha(x = alpha.rr)##
## Reliability analysis
## Call: psych::alpha(x = alpha.rr)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd
## 0.7 0.7 0.65 0.37 2.3 0.031 3.7 1
##
## lower alpha upper 95% confidence boundaries
## 0.64 0.7 0.76
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N
## give time out or punishments 0.64 0.64 0.55 0.37 1.8
## help with chores 0.71 0.71 0.63 0.45 2.5
## talk about setting limits 0.61 0.61 0.54 0.35 1.6
## talk sternly 0.58 0.58 0.48 0.31 1.4
## alpha se
## give time out or punishments 0.040
## help with chores 0.032
## talk about setting limits 0.043
## talk sternly 0.046
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## give time out or punishments 203 0.73 0.73 0.59 0.48 3.1 1.2
## help with chores 212 0.67 0.64 0.43 0.36 4.1 1.3
## talk about setting limits 208 0.78 0.75 0.62 0.52 4.2 1.4
## talk sternly 230 0.80 0.79 0.70 0.58 3.8 1.3
##
## Non missing response frequency for each item
## 1 2 3 4 5 6 miss
## give time out or punishments 0.12 0.21 0.31 0.24 0.12 0.01 0.19
## help with chores 0.04 0.08 0.21 0.19 0.35 0.13 0.15
## talk about setting limits 0.02 0.11 0.22 0.17 0.29 0.20 0.17
## talk sternly 0.03 0.10 0.33 0.25 0.19 0.11 0.08Affection and Attachment
wide.bev <- db %>%
filter(category_bev == "AA") %>%
select(sid, short_sent, rating) %>%
spread(short_sent, rating)
alpha.aa <- as.matrix(select(wide.bev, -sid))
psych::alpha(x = alpha.aa)##
## Reliability analysis
## Call: psych::alpha(x = alpha.aa)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd
## 0.55 0.59 0.6 0.27 1.4 0.048 4.4 0.87
##
## lower alpha upper 95% confidence boundaries
## 0.46 0.55 0.64
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se
## hug and kiss 0.40 0.42 0.34 0.19 0.71 0.066
## sleep in the same bed 0.67 0.68 0.64 0.41 2.09 0.037
## spend time cuddling 0.28 0.32 0.26 0.14 0.48 0.078
## talk about feelings 0.53 0.59 0.59 0.32 1.43 0.053
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## hug and kiss 249 0.69 0.75 0.71 0.47 5.5 1.0
## sleep in the same bed 244 0.62 0.51 0.20 0.16 3.0 1.6
## spend time cuddling 246 0.79 0.81 0.81 0.56 4.9 1.3
## talk about feelings 205 0.56 0.61 0.35 0.26 4.1 1.2
##
## Non missing response frequency for each item
## 1 2 3 4 5 6 miss
## hug and kiss 0.00 0.02 0.07 0.03 0.15 0.73 0.00
## sleep in the same bed 0.26 0.15 0.22 0.11 0.19 0.07 0.02
## spend time cuddling 0.02 0.05 0.10 0.09 0.31 0.43 0.02
## talk about feelings 0.02 0.06 0.29 0.18 0.33 0.12 0.18Early Learning
wide.bev <- db %>%
filter(category_bev == "EL") %>%
select(sid, short_sent, rating) %>%
spread(short_sent, rating)
alpha.el <- as.matrix(select(wide.bev, -sid))
psych::alpha(x = alpha.el)##
## Reliability analysis
## Call: psych::alpha(x = alpha.el)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd
## 0.7 0.71 0.65 0.38 2.4 0.031 4.3 1
##
## lower alpha upper 95% confidence boundaries
## 0.64 0.7 0.76
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N
## educational programming 0.70 0.70 0.61 0.44 2.3
## make observations 0.62 0.63 0.54 0.36 1.7
## practice numbers and letters 0.61 0.61 0.52 0.34 1.6
## read 0.63 0.64 0.54 0.37 1.7
## alpha se
## educational programming 0.033
## make observations 0.041
## practice numbers and letters 0.043
## read 0.040
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## educational programming 230 0.71 0.67 0.48 0.40 4.3 1.4
## make observations 224 0.76 0.75 0.62 0.52 4.3 1.3
## practice numbers and letters 221 0.76 0.76 0.65 0.54 4.3 1.3
## read 242 0.75 0.74 0.62 0.50 4.5 1.2
##
## Non missing response frequency for each item
## 1 2 3 4 5 6 miss
## educational programming 0.06 0.06 0.13 0.19 0.37 0.19 0.08
## make observations 0.01 0.08 0.27 0.15 0.25 0.24 0.10
## practice numbers and letters 0.03 0.06 0.21 0.19 0.34 0.17 0.12
## read 0.02 0.04 0.15 0.15 0.41 0.22 0.03Early Learning and Rules and Respect items hang together pretty well (alphas = .70) but Affection and Attachment items are not as great (alpha = .55). Dropping “sleep in the same bed” would help. Also, “hug and kiss” is close to ceiling with most people reporting “multiple times every day.”
4.2 Demographic predictors of behaviors
Education
mf <- bevs %>%
left_join(subinfo)%>%
filter(education != "") %>%
group_by(education, category_bev) %>%
multi_boot_standard(col = "rating_bev", na.rm = TRUE)
ggplot(mf, aes(category_bev, mean, fill=education)) +
geom_bar(stat="identity", position = "dodge") +
geom_linerange(aes(ymin = ci_lower, ymax = ci_upper),
position = position_dodge(width = .9)) +
scale_fill_solarized()
Gender
mf <- bevs %>%
left_join(subinfo)%>%
filter(gender == "Man" || gender == "Woman") %>%
group_by(gender, category_bev) %>%
multi_boot_standard(col = "rating_bev", na.rm = TRUE)
ggplot(mf, aes(category_bev, mean, fill=gender)) +
geom_bar(stat="identity", position = "dodge") +
geom_linerange(aes(ymin = ci_lower, ymax = ci_upper),
position = position_dodge(width = .9)) +
scale_fill_solarized()
Moms are engaging with their children more overall.
Age of child
mf <- bevs %>%
left_join(subinfo)%>%
filter(behave_age != "") %>%
group_by(behave_age, category_bev) %>%
multi_boot_standard(col = "rating_bev", na.rm = TRUE)
ggplot(mf, aes(category_bev, mean, fill=behave_age)) +
geom_bar(stat="identity", position = "dodge") +
geom_linerange(aes(ymin = ci_lower, ymax = ci_upper),
position = position_dodge(width = .9)) 
More behaviors are possible as kids get older.
Race
mf <- bevs %>%
left_join(subinfo)%>%
filter(race != "NULL") %>%
group_by(race, category_bev) %>%
multi_boot_standard(col = "rating_bev", na.rm = TRUE)
ggplot(mf, aes(category_bev, mean, fill=race)) +
geom_bar(stat="identity", position = "dodge") +
geom_linerange(aes(ymin = ci_lower, ymax = ci_upper),
position = position_dodge(width = .9)) +
scale_fill_solarized()
SES
mf <- bevs %>%
left_join(subinfo)%>%
filter(ses != "") %>%
group_by(ses, category_bev) %>%
multi_boot_standard(col = "rating_bev", na.rm = TRUE)
ggplot(mf, aes(category_bev, mean, fill=ses)) +
geom_bar(stat="identity", position = "dodge") +
geom_linerange(aes(ymin = ci_lower, ymax = ci_upper),
position = position_dodge(width = .9)) 
5 Attitudes and Behaviors
This might not be the best plot- I’d rather see the individual behaviors, but not sure the best way to present this without overwhelming.
ggplot(all, aes(x= rating_bev, y = rating_paq)) +
facet_grid(category_bev ~category_paq) +
geom_jitter(aes(color = category_paq)) +
xlab("Frequency of behavior") +
ylab("PAQ score") +
scale_colour_solarized()+
geom_smooth(method="lm", se=FALSE) 
5.1 Stats
Set up dataframes for analyses.
d <- db %>%
left_join(atts)%>%
left_join(subinfo)%>%
filter(!is.na(rating))%>%
filter(children != 0)%>%
filter(behave_age != "older")%>%
filter(behave_age != "")%>%
select(sid, short_sent, rating, category_paq, category_bev, rating_paq, behave_age)%>%
spread(category_paq, rating_paq)
d$behave_age <- as.character(d$behave_age)
d$behave_age[d$behave_age == "0-6 months"] <- 1
d$behave_age[d$behave_age == "7-12 months"] <- 7
d$behave_age[d$behave_age == "1-1.5"] <- 13
d$behave_age[d$behave_age == "1.5-2"] <- 19
d$behave_age[d$behave_age == "2-2.5"] <- 25
d$behave_age[d$behave_age == "2.5-3"] <- 31
d$behave_age[d$behave_age == "3-3.5"] <- 37
d$behave_age[d$behave_age == "3.5-4"] <- 43
d$behave_age[d$behave_age == "4-4.5"] <- 49
d$behave_age[d$behave_age == "4.5-5"] <- 55
d$behave_age <- as.numeric(d$behave_age)
d<- d%>%
mutate(child_age = behave_age)%>%
select(-behave_age)
d_aa <- d%>%
filter(category_bev == "AA")%>%
filter(!is.na(rating))
d_el <- d%>%
filter(category_bev == "EL")%>%
filter(!is.na(rating))
d_rr <- d%>%
filter(category_bev == "RR")%>%
filter(!is.na(rating))Separate models for each category of behavior. Do PAQ subscale scores predict the frequency of parenting behaviors?
5.1.1 Affection and Attachment
model <- summary(lmer(rating ~ AA + RR + EL + child_age +
(1|sid) +
(1|short_sent), #behavior item
data = d_aa))
lm <- summary(model)
lm## Linear mixed model fit by REML t-tests use Satterthwaite approximations
## to degrees of freedom [lmerMod]
## Formula: rating ~ AA + RR + EL + child_age + (1 | sid) + (1 | short_sent)
## Data: d_aa
##
## REML criterion at convergence: 2980.8
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.8207 -0.5373 0.1403 0.6197 2.7269
##
## Random effects:
## Groups Name Variance Std.Dev.
## sid (Intercept) 0.1764 0.4199
## short_sent (Intercept) 1.1584 1.0763
## Residual 1.3433 1.1590
## Number of obs: 909, groups: sid, 240; short_sent, 4
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.180519 0.600552 4.600000 3.631 0.0174 *
## AA 0.452878 0.077920 233.570000 5.812 2.01e-08 ***
## RR 0.004290 0.058123 234.490000 0.074 0.9412
## EL -0.018630 0.078732 233.450000 -0.237 0.8132
## child_age 0.005000 0.003186 238.790000 1.569 0.1179
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) AA RR EL
## AA -0.075
## RR -0.135 -0.103
## EL -0.115 -0.716 -0.304
## child_age -0.071 -0.105 -0.141 0.0825.1.2 Early Learning
#for EL behaviors
model <- summary(lmer(rating ~ AA + RR + EL + child_age +
(1|sid) +
(1|short_sent), #behavior item
data = d_el))
lm <- summary(model)
lm## Linear mixed model fit by REML t-tests use Satterthwaite approximations
## to degrees of freedom [lmerMod]
## Formula: rating ~ AA + RR + EL + child_age + (1 | sid) + (1 | short_sent)
## Data: d_el
##
## REML criterion at convergence: 2783.3
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.4300 -0.5848 0.0911 0.6684 2.8840
##
## Random effects:
## Groups Name Variance Std.Dev.
## sid (Intercept) 0.34079 0.5838
## short_sent (Intercept) 0.01706 0.1306
## Residual 1.07942 1.0390
## Number of obs: 884, groups: sid, 238; short_sent, 4
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 1.429e+00 2.993e-01 1.773e+02 4.774 3.77e-06 ***
## AA 1.329e-01 8.582e-02 2.218e+02 1.549 0.122805
## RR 4.715e-02 6.421e-02 2.168e+02 0.734 0.463596
## EL 3.357e-01 8.686e-02 2.205e+02 3.864 0.000146 ***
## child_age 1.371e-02 3.551e-03 2.263e+02 3.860 0.000148 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) AA RR EL
## AA -0.165
## RR -0.299 -0.095
## EL -0.249 -0.719 -0.310
## child_age -0.152 -0.112 -0.151 0.0865.1.3 Rules and Respect
model <- summary(lmer(rating ~ AA + RR + EL + child_age +
(1|sid) +
(1|short_sent), #behavior item
data = d_rr))
lm <- summary(model)
lm## Linear mixed model fit by REML t-tests use Satterthwaite approximations
## to degrees of freedom [lmerMod]
## Formula: rating ~ AA + RR + EL + child_age + (1 | sid) + (1 | short_sent)
## Data: d_rr
##
## REML criterion at convergence: 2609.5
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.69946 -0.64715 0.00867 0.67535 2.60067
##
## Random effects:
## Groups Name Variance Std.Dev.
## sid (Intercept) 0.5432 0.7370
## short_sent (Intercept) 0.2504 0.5004
## Residual 1.0107 1.0053
## Number of obs: 821, groups: sid, 226; short_sent, 4
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.071117 0.421085 22.080000 4.919 6.36e-05 ***
## AA 0.054227 0.099878 224.220000 0.543 0.58772
## RR 0.203208 0.074823 221.060000 2.716 0.00713 **
## EL -0.002244 0.100041 215.480000 -0.022 0.98213
## child_age 0.019805 0.004335 224.940000 4.568 8.10e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) AA RR EL
## AA -0.141
## RR -0.240 -0.108
## EL -0.202 -0.713 -0.303
## child_age -0.126 -0.115 -0.163 0.0766 Conclusions
PAQ scores predict Early Learning and Affection and attachment behaviors in the way we predicted- higher PAQ scores within a subscale predict more frequent parenting behaviors within the same category (i.e., frequency of Affection and Attachment behaviors are predicted by AA PAQ scores but not EL or RR PAQ scores). Additionally, Early Learning and Rules and Respect but not Affection and Attachment behaviors increase with child age.