Notes

Note on things we still need to do

work on testing random effects for the pre-interest by activity interactions
centering / standardizing predictor variables

Just a short note on how to interpret R-squared values

For linear mixed models, an r-squared approximation by computing the correlation between the fitted and observed values, as suggested by Byrnes (2008), is returned as well as a simplified version of the Omega-squared value (1 - (residual variance / response variance), Xu (2003), Nakagawa, Schielzeth 2013), unless n is specified.

0. Loading, setting up

0A. Loading packages

library(tidyverse)
library(lme4)
library(corrr)
library(forcats)
library(jmRtools)
library(stringr)

0B. Loading data

esm <- read_csv("/Users/joshuarosenberg/Google Drive/SCHMIDTLAB/PSE/data/STEM-IE/STEM-IE-esm.csv")
pre_survey_data_processed <- read_csv("/Users/joshuarosenberg/Google Drive/SCHMIDTLAB/PSE/data/STEM-IE/STEM-IE-pre-survey.csv")
post_survey_data_partially_processed <- read_csv("/Users/joshuarosenberg/Google Drive/SCHMIDTLAB/PSE/data/STEM-IE/STEM-IE-post-survey.csv")
video <- read_csv("/Users/joshuarosenberg/Google Drive/SCHMIDTLAB/PSE/data/STEM-IE/STEM-IE-video.csv")

pqa <- read_csv("/Users/joshuarosenberg/Google Drive/SCHMIDTLAB/PSE/data/STEM-IE/STEM-IE-pqa.csv")
attendance <- read_csv("/Users/joshuarosenberg/Google Drive/SCHMIDTLAB/PSE/data/STEM-IE/STEM-IE-attendance.csv")

class_data <- read_csv("/Users/joshuarosenberg/Google Drive/SCHMIDTLAB/PSE/data/STEM-IE/STEM-IE-class-video.csv")
demographics <- read_csv("/Users/joshuarosenberg/Google Drive/SCHMIDTLAB/PSE/data/STEM-IE/STEM-IE-demographics.csv")
# demographics$participant_ID <- ifelse(demographics$participant_ID == 7187, NA, demographics$participant_ID)
# write_csv(demographics, "/Users/joshuarosenberg/Google Drive/SCHMIDTLAB/PSE/data/STEM-IE/STEM-IE-demographics.csv")
parent <- read_csv("/Users/joshuarosenberg/Google Drive/SCHMIDTLAB/PSE/data/STEM-IE/STEM-IE-parent.csv")
parent <- rename(parent, participant_ID = ParticipantID)

pm <- read_csv("~/Google Drive/1_Research/STEM IE - JJP/STEM-IE/data/final/program_match.csv")

0C. Joining

Note that parent and future_goals_plans had to be processed first for merging later on; can change.

parent <- mutate(parent,
                 HS_or_above = ifelse(q07a == 1, 1,
                                      ifelse(q07a == 0, 0, NA)))

demographics <- left_join(demographics, parent)

## Joining, by = "participant_ID"

df <- left_join(esm, pre_survey_data_processed, by = "participant_ID") # esm & pre-survey

post_survey_data_partially_processed$post_future_goals_plans <- jmRtools::composite_mean_maker(post_survey_data_partially_processed,
                                                                                               post_future_job_become_STEM,
                                                                                               post_future_job_use_science_math,
                                                                                               post_future_job_work_science_computer)

pre_survey_data_processed$pre_future_goals_plans <- jmRtools::composite_mean_maker(pre_survey_data_processed,
                                                                                   pre_future_job_become_STEM,
                                                                                   pre_future_job_use_science_math,
                                                                                   pre_future_job_work_science_computer)

df <- left_join(df, post_survey_data_partially_processed, by = "participant_ID") # df & post-survey

df <- left_join(df, video, by = c("program_ID", "response_date", "sociedad_class", "signal_number")) # df & video
df <- left_join(df, demographics, by = c("participant_ID", "program_ID")) # df and demographics

0D. Processing CLASS video data

class_data$sociedad_class <- ifelse(class_data$eighth_math == 1, "8th Math",
                                    ifelse(class_data$seventh_math == 1, "7th Math",
                                           ifelse(class_data$sixth_math == 1, "6th Math",
                                                  ifelse(class_data$robotics == 1, "Robotics",
                                                         ifelse(class_data$dance == 1, "Dance", NA)))))

class_data <- rename(class_data, 
                     response_date = Responsedate,
                     signal_number = r_signal_number,
                     program_ID = SiteIDNumeric)

class_data$CLASS_comp <- jmRtools::composite_mean_maker(class_data, ID, P, AI, ILF, QF, CU)

class_data <- select(class_data,
                     program_ID,
                     response_date,
                     signal_number,
                     sociedad_class,
                     CLASS_comp,
                     CLASS_EmotionalSupportEncouragement = EmotionalSupportEncouragement,
                     CLASS_InstructionalSupport = InstructionalSupport,
                     CLASS_Autonomy = Autonomy,
                     CLASS_STEMConceptualDevelopment = STEMConceptualDevelopment,
                     CLASS_ActivityLeaderEnthusiasm = ActivityLeaderEnthusiasm)

class_data$response_date <- as.character(class_data$response_date)

df <- mutate(df, response_date = as.character(response_date))

df <- left_join(df, class_data, by = c("program_ID", "response_date", "signal_number", "sociedad_class"))

OE. Further processing

df$participant_ID <- as.factor(df$participant_ID)
df$program_ID <- as.factor(df$program_ID)
df$beep_ID <- as.factor(df$beep_ID)
df$beep_ID_new <- as.factor(df$beep_ID_new)

# Recode problem solving, off task, student presentation, and showing video as other

df$youth_activity_rc <- ifelse(df$youth_activity == "Off Task", "Not Focused", df$youth_activity)

df$youth_activity_rc <- ifelse(df$youth_activity_rc == "Student Presentation" | df$youth_activity_rc == "Problem Solving", "Creating Product", df$youth_activity_rc)

df$youth_activity_rc <- ifelse(df$youth_activity_rc == "Showing Video", "Program Staff Led", df$youth_activity_rc)

df$youth_activity_rc <- as.factor(df$youth_activity_rc)

df$youth_activity_rc <- forcats::fct_relevel(df$youth_activity_rc, "Not Focused")

df$relevance <- jmRtools::composite_mean_maker(df, use_outside, future_goals, important)

# need to move up
video$youth_activity_rc <- ifelse(video$youth_activity == "Off Task", "Not Focused", video$youth_activity)

video$youth_activity_rc <- ifelse(video$youth_activity_rc == "Student Presentation" | video$youth_activity_rc == "Problem Solving", "Creating Product", video$youth_activity_rc)
video$youth_activity_rc <- ifelse(video$youth_activity_rc == "Showing Video", "Program Staff Led", video$youth_activity_rc)

ncol(df)

## [1] 161

0F: CLASS correlations and a plot of the composite

df %>% 
    select(CLASS_comp, CLASS_EmotionalSupportEncouragement, CLASS_InstructionalSupport, CLASS_STEMConceptualDevelopment, CLASS_ActivityLeaderEnthusiasm, CLASS_Autonomy,
           challenge, relevance, learning, positive_affect) %>%  
    correlate() %>% 
    shave() %>% 
    fashion() %>%
    knitr::kable()

rowname	CLASS_comp	CLASS_EmotionalSupportEncouragement	CLASS_InstructionalSupport	CLASS_STEMConceptualDevelopment	CLASS_ActivityLeaderEnthusiasm	CLASS_Autonomy	challenge	relevance	learning
CLASS_comp
CLASS_EmotionalSupportEncouragement	.35
CLASS_InstructionalSupport	.98	.39
CLASS_STEMConceptualDevelopment	.96	.28	.89
CLASS_ActivityLeaderEnthusiasm	.74	.63	.77	.63
CLASS_Autonomy	.50	.29	.50	.51	.52
challenge	.06	.03	.06	.04	.07	.05
relevance	.05	-.01	.05	.04	.04	.02	.39
learning	.07	.00	.07	.07	.05	.02	.30	.65
positive_affect	.06	.01	.06	.05	.09	.02	.27	.52	.48

ggplot(df, aes(x = CLASS_comp)) +
    geom_histogram()

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

## Warning: Removed 172 rows containing non-finite values (stat_bin).

## 0G. Processing demographics

demographics %>% count(race)

## # A tibble: 6 x 2
##          race     n
##         <chr> <int>
## 1       Asian    14
## 2       Black    72
## 3    Hispanic    97
## 4 Multiracial     6
## 5       White    13
## 6        <NA>     3

df$urm <- ifelse(df$race %in% c("White", "Asian"), 0, 1)
df$race <- as.factor(df$race)
df$race <- fct_lump(df$race, n = 2)
df$race_other <- fct_relevel(df$race, "Other")
df$gender_female <- as.factor(df$gender) # female is comparison_group
df$gender_female <- ifelse(df$gender_female == "F", 1, 
                           ifelse(df$gender_female == "M", 0, NA))

1. QUESTION 1

How are instructional practices in STEM summer programs related to perceptions of challenge, relevance, learning, and affect for participating youth?

1A. Null models

Note that our normal display presently doesn’t work if there are no predictor variables: it should be fixed in a bit, but for now, we’re just printing the ICCs.

m0i <- lmer(challenge ~ 1 + 
                (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
            data = df)

sjstats::icc(m0i)

## Linear mixed model
##  Family: gaussian (identity)
## Formula: challenge ~ 1 + (1 | program_ID) + (1 | participant_ID) + (1 | beep_ID_new)
## 
##      ICC (beep_ID_new): 0.066428
##   ICC (participant_ID): 0.371089
##       ICC (program_ID): 0.034016

m0ii <- lmer(relevance ~ 1 + 
                 (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
             data = df)

sjstats::icc(m0ii)

## Linear mixed model
##  Family: gaussian (identity)
## Formula: relevance ~ 1 + (1 | program_ID) + (1 | participant_ID) + (1 | beep_ID_new)
## 
##      ICC (beep_ID_new): 0.019134
##   ICC (participant_ID): 0.515087
##       ICC (program_ID): 0.009082

m0iii <- lmer(learning ~ 1 + 
                  (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
              data = df)

sjstats::icc(m0iii)

## Linear mixed model
##  Family: gaussian (identity)
## Formula: learning ~ 1 + (1 | program_ID) + (1 | participant_ID) + (1 | beep_ID_new)
## 
##      ICC (beep_ID_new): 0.023511
##   ICC (participant_ID): 0.349134
##       ICC (program_ID): 0.000000

# df$positive_affect <- jmRtools::composite_mean_maker(df,
#                                                      happy, excited)
# 
# m0iv <- lmer(positive_affect ~ 1 + 
#                  (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
#              data = df)
# 
# sjstats::icc(m0iv)

1B. Models for youth activity (with CLASS composite)

m1i <- lmer(challenge ~ 1 + 
                youth_activity_rc +
                gender_female + 
                CLASS_comp +
                (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
            data = df)

sjPlot::sjt.lmer(m1i, p.kr = F, show.re.var = F, show.ci = F, show.se = T)

	challenge
	B	std. Error	p
Fixed Parts
(Intercept)	2.21	0.14	<.001
youth_activity_rc (Basic Skills Activity)	0.06	0.07	.399
youth_activity_rc (Creating Product)	0.29	0.08	<.001
youth_activity_rc (Field Trip Speaker)	-0.12	0.13	.359
youth_activity_rc (Lab Activity)	0.15	0.13	.245
youth_activity_rc (Program Staff Led)	-0.13	0.08	.112
gender_female	-0.25	0.11	.016
CLASS_comp	0.04	0.03	.155
Random Parts
N_{beep_ID_new}	228
N_{participant_ID}	201
N_{program_ID}	9
ICC_{beep_ID_new}	0.046
ICC_{participant_ID}	0.376
ICC_{program_ID}	0.032
Observations	2693
R² / Ω₀²	.527 / .520

m1ii <- lmer(relevance ~ 1 + 
                 youth_activity_rc +
                 gender_female + 
                 CLASS_comp +
                 (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
             data = df)

sjPlot::sjt.lmer(m1ii, p.kr = F, show.re.var = F, show.ci = F, show.se = T)

	relevance
	B	std. Error	p
Fixed Parts
(Intercept)	2.49	0.10	<.001
youth_activity_rc (Basic Skills Activity)	0.12	0.04	.004
youth_activity_rc (Creating Product)	0.18	0.05	<.001
youth_activity_rc (Field Trip Speaker)	0.27	0.07	<.001
youth_activity_rc (Lab Activity)	0.10	0.08	.183
youth_activity_rc (Program Staff Led)	0.11	0.05	.015
gender_female	-0.22	0.10	.032
CLASS_comp	0.03	0.02	.081
Random Parts
N_{beep_ID_new}	228
N_{participant_ID}	201
N_{program_ID}	9
ICC_{beep_ID_new}	0.006
ICC_{participant_ID}	0.518
ICC_{program_ID}	0.017
Observations	2693
R² / Ω₀²	.589 / .586

m1iii <- lmer(learning ~ 1 + 
                  youth_activity_rc +
                  gender_female + 
                  CLASS_comp +
                  (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
              data = df)

sjPlot::sjt.lmer(m1iii, p.kr = F, show.re.var = F, show.ci = F, show.se = T)

	learning
	B	std. Error	p
Fixed Parts
(Intercept)	2.53	0.10	<.001
youth_activity_rc (Basic Skills Activity)	0.17	0.05	.002
youth_activity_rc (Creating Product)	0.04	0.06	.499
youth_activity_rc (Field Trip Speaker)	0.06	0.10	.502
youth_activity_rc (Lab Activity)	0.09	0.10	.347
youth_activity_rc (Program Staff Led)	0.04	0.06	.490
gender_female	-0.06	0.10	.549
CLASS_comp	0.06	0.02	.005
Random Parts
N_{beep_ID_new}	228
N_{participant_ID}	201
N_{program_ID}	9
ICC_{beep_ID_new}	0.008
ICC_{participant_ID}	0.355
ICC_{program_ID}	0.006
Observations	2692
R² / Ω₀²	.427 / .421

df$positive_affect <- jmRtools::composite_mean_maker(df,
                                                     happy, excited)

# m1iv <- lmer(positive_affect ~ 1 + 
#                  youth_activity_rc +
#                  gender_female + 
#                  CLASS_comp +
#                  (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
#              na.action = "na.omit",
#              data = df)
# 
# sjPlot::sjt.lmer(m1iv, p.kr = F, show.re.var = F, show.ci = F, show.se = T)

2. QUESTION 2

How is the relationship between STEM practices and perceptions of challenge, relevance, learning, and affect moderated by: (a) youth characteristics at program entry (L2); (b) activity leader perceptions of effective instructional practice (L3 – limited power); (c) the type of activity(L1 – how different from STEM practices?); and (d) classroom versus field-based settings? STEM practices = CLASS items, value statements, etc. stuff from video

2A. Descriptives and correlations for youth activities and ESM variables

video %>% 
    left_join(pm) %>% 
    count(program_name, youth_activity_rc) %>% 
    filter(!is.na(youth_activity_rc)) %>% 
    spread(youth_activity_rc, n, fill = 0) %>% 
    gather(youth_activity_rc, frequency, -program_name) %>% 
    group_by(program_name) %>% 
    mutate(frequency_prop = frequency / sum(frequency)) %>% 
    ggplot(aes(x = reorder(youth_activity_rc, frequency_prop), y = frequency_prop)) +
    facet_wrap( ~ program_name) +
    geom_col() +
    theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
    ylab("Frequency Proportion") +
    xlab(NULL) +
    ggtitle("Frequency of Youth Activity (Recoded) Codes by Program")

df$youth_activity_rc_fac <- as.factor(df$youth_activity_rc)
dc <- as.tibble(psych::dummy.code(df$youth_activity_rc_fac))
df_ss <- bind_cols(df, dc)

df_ss %>% 
    select(challenge, relevance, learning, positive_affect, overall_pre_interest,
           `Not Focused`, `Basic Skills Activity`, `Creating Product`, 
           `Field Trip Speaker`, `Lab Activity`, `Program Staff Led`) %>% 
    correlate() %>% 
    shave() %>% 
    fashion() %>% 
    knitr::kable()

rowname	challenge	relevance	learning	positive_affect	overall_pre_interest	Not.Focused	Basic.Skills.Activity	Creating.Product	Field.Trip.Speaker	Lab.Activity
challenge
relevance	.39
learning	.30	.65
positive_affect	.27	.52	.48
overall_pre_interest	.00	.10	.08	.20
Not Focused	-.02	-.06	-.05	.04	-.02
Basic Skills Activity	-.01	-.01	.04	-.06	-.03	-.35
Creating Product	.12	.08	.04	.05	.08	-.33	-.25
Field Trip Speaker	-.05	.01	-.02	.01	.11	-.15	-.11	-.11
Lab Activity	.00	-.03	.01	.02	.06	-.14	-.11	-.10	-.05
Program Staff Led	-.06	.01	-.00	-.07	-.14	-.27	-.21	-.20	-.09	-.09

2B. Manually creating dummy codes for activity

df <- mutate(df,
             youth_activity_rc = as.character(youth_activity_rc),
             youth_activity_rc = case_when(
                 is.na(youth_activity_rc) ~ "Missing",
                 TRUE ~ youth_activity_rc
             ),
             youth_activity_rc = as.factor(youth_activity_rc),
             youth_activity_rc = forcats::fct_relevel(youth_activity_rc, "Basic Skills Activity")
)

x <- as_tibble(dummies::dummy(df$youth_activity_rc))
names(x) <-map_chr(str_split(names(x), "\\)"), ~ .[[2]])
x$Missing <- ifelse(x$Missing == 1, NA, x$Missing)
df <- bind_cols(df, x)

2B. Models for youth activity (with CLASS composite)

# df_ss <- filter(df, !is.na(Missing))
# 
# test <- lmer(challenge ~
#                  `Basic Skills Activity` +
#                  `Creating Product` +
#                  `Field Trip Speaker` +
#                  `Lab Activity` +
#                  `Program Staff Led` +
#                  (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
#              data = df_ss)
# 
# sjPlot::sjt.lmer(test,  p.kr = F, show.re.var = F, show.ci = F, show.se = T)
# 
m1i <- lmer(challenge ~ 1 +
                youth_activity_rc +
                gender_female +
                CLASS_comp +
                overall_pre_interest +
                (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
            data = df)

summary(m1i)

## Linear mixed model fit by REML ['lmerMod']
## Formula: challenge ~ 1 + youth_activity_rc + gender_female + CLASS_comp +  
##     overall_pre_interest + (1 | program_ID) + (1 | participant_ID) +  
##     (1 | beep_ID_new)
##    Data: df
## 
## REML criterion at convergence: 6592.8
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.8581 -0.6439 -0.0293  0.5623  3.3297 
## 
## Random effects:
##  Groups         Name        Variance Std.Dev.
##  beep_ID_new    (Intercept) 0.06129  0.2476  
##  participant_ID (Intercept) 0.46907  0.6849  
##  program_ID     (Intercept) 0.04487  0.2118  
##  Residual                   0.65825  0.8113  
## Number of obs: 2483, groups:  
## beep_ID_new, 228; participant_ID, 180; program_ID, 9
## 
## Fixed effects:
##                                         Estimate Std. Error t value
## (Intercept)                             2.232770   0.252172   8.854
## youth_activity_rcBasic Skills Activity  0.051552   0.072539   0.711
## youth_activity_rcCreating Product       0.270075   0.078911   3.423
## youth_activity_rcField Trip Speaker    -0.143690   0.136342  -1.054
## youth_activity_rcLab Activity           0.106152   0.136731   0.776
## youth_activity_rcProgram Staff Led     -0.152025   0.082268  -1.848
## gender_female                          -0.253720   0.111900  -2.267
## CLASS_comp                              0.037021   0.027676   1.338
## overall_pre_interest                    0.003366   0.068458   0.049
## 
## Correlation of Fixed Effects:
##             (Intr) y__BSA yt__CP y__FTS yt__LA y__PSL gndr_f CLASS_
## yth_ctv_BSA  0.020                                                 
## yth_ctvt_CP  0.073  0.496                                          
## yth_ctv_FTS -0.003  0.270  0.252                                   
## yth_ctvt_LA  0.042  0.281  0.296  0.161                            
## yth_ctv_PSL -0.033  0.454  0.370  0.201  0.232                     
## gender_feml -0.261 -0.008  0.001  0.004 -0.007 -0.015              
## CLASS_comp  -0.329 -0.353 -0.474 -0.126 -0.267 -0.215  0.006       
## ovrll_pr_nt -0.824 -0.005 -0.007 -0.020 -0.007  0.019  0.038 -0.015

sjPlot::sjt.lmer(m1i, p.kr = F, show.re.var = T, show.ci = F, show.se = T)

	challenge
	B	std. Error	p
Fixed Parts
(Intercept)	2.23	0.25	<.001
youth_activity_rc (Basic Skills Activity)	0.05	0.07	.477
youth_activity_rc (Creating Product)	0.27	0.08	<.001
youth_activity_rc (Field Trip Speaker)	-0.14	0.14	.292
youth_activity_rc (Lab Activity)	0.11	0.14	.438
youth_activity_rc (Program Staff Led)	-0.15	0.08	.065
gender_female	-0.25	0.11	.023
CLASS_comp	0.04	0.03	.181
overall_pre_interest	0.00	0.07	.961
Random Parts
σ²	0.658
τ_{00, beep_ID_new}	0.061
τ_{00, participant_ID}	0.469
τ_{00, program_ID}	0.045
N_{beep_ID_new}	228
N_{participant_ID}	180
N_{program_ID}	9
ICC_{beep_ID_new}	0.050
ICC_{participant_ID}	0.380
ICC_{program_ID}	0.036
Observations	2483
R² / Ω₀²	.530 / .522

m1ii <- lmer(relevance ~ 1 + 
                 youth_activity_rc +
                 gender_female + 
                 CLASS_comp +
                 (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
             data = df)

sjPlot::sjt.lmer(m1ii, p.kr = F, show.re.var = T, show.ci = F, show.se = T)

	relevance
	B	std. Error	p
Fixed Parts
(Intercept)	2.49	0.10	<.001
youth_activity_rc (Basic Skills Activity)	0.12	0.04	.004
youth_activity_rc (Creating Product)	0.18	0.05	<.001
youth_activity_rc (Field Trip Speaker)	0.27	0.07	<.001
youth_activity_rc (Lab Activity)	0.10	0.08	.183
youth_activity_rc (Program Staff Led)	0.11	0.05	.015
gender_female	-0.22	0.10	.032
CLASS_comp	0.03	0.02	.081
Random Parts
σ²	0.420
τ_{00, beep_ID_new}	0.005
τ_{00, participant_ID}	0.474
τ_{00, program_ID}	0.015
N_{beep_ID_new}	228
N_{participant_ID}	201
N_{program_ID}	9
ICC_{beep_ID_new}	0.006
ICC_{participant_ID}	0.518
ICC_{program_ID}	0.017
Observations	2693
R² / Ω₀²	.589 / .586

m1iii <- lmer(learning ~ 1 + 
                  youth_activity_rc +
                  gender_female + 
                  CLASS_comp +
                  (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
              data = df)

sjPlot::sjt.lmer(m1iii, p.kr = F, show.re.var = F, show.ci = F, show.se = T)

	learning
	B	std. Error	p
Fixed Parts
(Intercept)	2.53	0.10	<.001
youth_activity_rc (Basic Skills Activity)	0.17	0.05	.002
youth_activity_rc (Creating Product)	0.04	0.06	.499
youth_activity_rc (Field Trip Speaker)	0.06	0.10	.502
youth_activity_rc (Lab Activity)	0.09	0.10	.347
youth_activity_rc (Program Staff Led)	0.04	0.06	.490
gender_female	-0.06	0.10	.549
CLASS_comp	0.06	0.02	.005
Random Parts
N_{beep_ID_new}	228
N_{participant_ID}	201
N_{program_ID}	9
ICC_{beep_ID_new}	0.008
ICC_{participant_ID}	0.355
ICC_{program_ID}	0.006
Observations	2692
R² / Ω₀²	.427 / .421

df$positive_affect <- jmRtools::composite_mean_maker(df,
                                                     happy, excited)

# m1iv <- lmer(positive_affect ~ 1 + 
#                  youth_activity_rc +
#                  gender_female + 
#                  CLASS_comp +
#                  (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
#              na.action = "na.omit",
#              data = df)
# 
# sjPlot::sjt.lmer(m1iv, p.kr = F, show.re.var = F, show.ci = F, show.se = T)

3. QUESTION 3

How do in-the-moment experiences of youth (i.e., challenge, relevance, learning, and affect) cultivate situational interest and engagement in STEM activities?

3A. Correlations for situational experiences (interest and engagement)

df$overall_engagement <- jmRtools::composite_mean_maker(df, hard_working, concentrating, enjoy)

df %>% 
    select(overall_engagement, interest, challenge, relevance, learning, positive_affect) %>%  
    correlate() %>% 
    shave() %>% 
    fashion() %>%
    knitr::kable()

rowname	overall_engagement	interest	challenge	relevance	learning
overall_engagement
interest	.69
challenge	.30	.28
relevance	.65	.61	.39
learning	.68	.56	.30	.65
positive_affect	.65	.56	.27	.52	.48

3B. Models for situational experiences (interest and engagement; with CLASS composite)

m3i0 <- lmer(interest ~ 1 +
                 overall_pre_interest + 
                 (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
             data = df)

sjPlot::sjt.lmer(m3i0, p.kr = F, show.re.var = F, show.ci = F, show.se = T)

## Computing p-values via Wald-statistics approximation (treating t as Wald z).

	interest
	B	std. Error	p
Fixed Parts
(Intercept)	2.44	0.19	<.001
overall_pre_interest	0.14	0.06	.018
Random Parts
N_{beep_ID_new}	248
N_{participant_ID}	181
N_{program_ID}	9
ICC_{beep_ID_new}	0.040
ICC_{participant_ID}	0.328
ICC_{program_ID}	0.017
Observations	2738
R² / Ω₀²	.448 / .438

m3ii0 <- lmer(overall_engagement ~ 1 + 
                  overall_pre_interest + 
                  (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
              data = df)

sjPlot::sjt.lmer(m3ii0, p.kr = F, show.re.var = F, show.ci = F, show.se = T)

## Computing p-values via Wald-statistics approximation (treating t as Wald z).

	overall_engagement
	B	std. Error	p
Fixed Parts
(Intercept)	2.50	0.16	<.001
overall_pre_interest	0.11	0.05	.030
Random Parts
N_{beep_ID_new}	248
N_{participant_ID}	181
N_{program_ID}	9
ICC_{beep_ID_new}	0.034
ICC_{participant_ID}	0.429
ICC_{program_ID}	0.000
Observations	2738
R² / Ω₀²	.523 / .518

3C. Models for situational experiences (interest and engagement; with CLASS composite)

m3i <- lmer(interest ~ 1 +
                challenge + relevance + learning +
                gender_female + 
                classroom_versus_field_enrichment +
                CLASS_comp + 
                youth_activity_rc +
                (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
            data = df)

sjPlot::sjt.lmer(m3i, p.kr = F, show.re.var = F, show.ci = F, show.se = T)

	interest
	B	std. Error	p
Fixed Parts
(Intercept)	0.97	0.11	<.001
challenge	0.03	0.02	.042
relevance	0.44	0.02	<.001
learning	0.24	0.02	<.001
gender_female	0.01	0.05	.822
classroom_versus_field_enrichment	0.04	0.05	.391
CLASS_comp	0.00	0.02	.821
youth_activity_rc (Basic Skills Activity)	-0.13	0.06	.025
youth_activity_rc (Creating Product)	-0.05	0.06	.431
youth_activity_rc (Field Trip Speaker)	0.01	0.11	.939
youth_activity_rc (Lab Activity)	-0.03	0.11	.775
youth_activity_rc (Program Staff Led)	-0.07	0.06	.302
Random Parts
N_{beep_ID_new}	228
N_{participant_ID}	201
N_{program_ID}	9
ICC_{beep_ID_new}	0.045
ICC_{participant_ID}	0.114
ICC_{program_ID}	0.024
Observations	2692
R² / Ω₀²	.564 / .562

m3ii <- lmer(overall_engagement ~ 1 + 
                 challenge + relevance + learning + 
                 gender_female + 
                 classroom_versus_field_enrichment +
                 CLASS_comp + 
                 youth_activity_rc +
                 (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
             data = df)

sjPlot::sjt.lmer(m3ii, p.kr = F, show.re.var = F, show.ci = F, show.se = T)

	overall_engagement
	B	std. Error	p
Fixed Parts
(Intercept)	0.96	0.08	<.001
challenge	0.04	0.01	.003
relevance	0.33	0.02	<.001
learning	0.32	0.01	<.001
gender_female	0.04	0.05	.361
classroom_versus_field_enrichment	0.10	0.03	.005
CLASS_comp	0.00	0.01	.851
youth_activity_rc (Basic Skills Activity)	0.01	0.04	.830
youth_activity_rc (Creating Product)	-0.01	0.04	.814
youth_activity_rc (Field Trip Speaker)	0.07	0.07	.378
youth_activity_rc (Lab Activity)	0.03	0.07	.672
youth_activity_rc (Program Staff Led)	-0.07	0.04	.130
Random Parts
N_{beep_ID_new}	228
N_{participant_ID}	201
N_{program_ID}	9
ICC_{beep_ID_new}	0.036
ICC_{participant_ID}	0.233
ICC_{program_ID}	0.031
Observations	2692
R² / Ω₀²	.706 / .705

m3iii <- lmer(interest ~ 1 +
                  challenge + relevance + learning + 
                  overall_pre_interest +
                  classroom_versus_field_enrichment +
                  gender_female + 
                  CLASS_comp + 
                  youth_activity_rc +
                  (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
              data = df)

sjPlot::sjt.lmer(m3iii, p.kr = F, show.re.var = F, show.ci = F, show.se = T)

	interest
	B	std. Error	p
Fixed Parts
(Intercept)	0.78	0.15	<.001
challenge	0.03	0.02	.073
relevance	0.45	0.02	<.001
learning	0.24	0.02	<.001
overall_pre_interest	0.06	0.03	.067
classroom_versus_field_enrichment	0.06	0.05	.215
gender_female	0.02	0.05	.669
CLASS_comp	0.01	0.02	.744
youth_activity_rc (Basic Skills Activity)	-0.15	0.06	.009
youth_activity_rc (Creating Product)	-0.05	0.07	.413
youth_activity_rc (Field Trip Speaker)	0.01	0.11	.938
youth_activity_rc (Lab Activity)	-0.04	0.11	.685
youth_activity_rc (Program Staff Led)	-0.10	0.07	.148
Random Parts
N_{beep_ID_new}	228
N_{participant_ID}	180
N_{program_ID}	9
ICC_{beep_ID_new}	0.047
ICC_{participant_ID}	0.114
ICC_{program_ID}	0.022
Observations	2482
R² / Ω₀²	.561 / .558

m3iv <- lmer(overall_engagement ~ 1 + 
                 challenge + relevance + learning + 
                 overall_pre_interest +
                 classroom_versus_field_enrichment +
                 gender_female + 
                 CLASS_comp + 
                 (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
             data = df)

sjPlot::sjt.lmer(m3iv, p.kr = F, show.re.var = F, show.ci = F, show.se = T)

	overall_engagement
	B	std. Error	p
Fixed Parts
(Intercept)	0.77	0.12	<.001
challenge	0.04	0.01	.003
relevance	0.33	0.02	<.001
learning	0.31	0.01	<.001
overall_pre_interest	0.06	0.03	.049
classroom_versus_field_enrichment	0.08	0.03	.010
gender_female	0.05	0.05	.284
CLASS_comp	0.00	0.01	.765
Random Parts
N_{beep_ID_new}	231
N_{participant_ID}	180
N_{program_ID}	9
ICC_{beep_ID_new}	0.038
ICC_{participant_ID}	0.239
ICC_{program_ID}	0.026
Observations	2513
R² / Ω₀²	.705 / .704

4. QUESTION 4

Are situational (momentary) interest and engagement in STEM activities across several weeks associated with changes in: (a) individual (sustained) interest in STEM; (c) future goals and aspirations related to STEM?

A step we don’t yet take is to use output from mixed-effects models for each of the situational experiences variables to predict these outcomes; not yet added.

4A. Descriptives for situational experiences and future goals and plans

participant_df <- df %>% 
    select(participant_ID, challenge, relevance, learning, positive_affect, good_at, post_future_goals_plans) %>% 
    group_by(participant_ID) %>% 
    mutate_at(vars(challenge, relevance, learning, positive_affect, good_at), funs(mean, sd)) %>%
    select(participant_ID, contains("mean"), contains("sd"), post_future_goals_plans) %>% 
    distinct()

df_ss <- left_join(df, participant_df)

df_ss <- select(df_ss, 
                participant_ID, program_ID,
                challenge_mean, relevance_mean, learning_mean, positive_affect_mean, good_at_mean,
                challenge_sd, relevance_sd, learning_sd, positive_affect_sd, good_at_sd,
                overall_post_interest, overall_pre_interest, post_future_goals_plans,
                future_goals)

df_ss <- distinct(df_ss)

df_ss$program_ID <- as.integer(df_ss$program_ID)

df_ss <- left_join(df_ss, pm)

4B. Using means and standard deviations to predict post-interest and future goals and aspirations; null models and then primary models

m4i0 <- lmer(overall_post_interest ~
                 (1|program_ID),
             data = df_ss)

sjstats::icc(m4i0)

## Linear mixed model
##  Family: gaussian (identity)
## Formula: overall_post_interest ~ (1 | program_ID)
## 
##   ICC (program_ID): 0.300182

m4i <- lmer(overall_post_interest ~ 1 + 
                challenge_mean + challenge_sd +
                learning_mean + learning_sd +
                relevance_mean + relevance_sd +
                # positive_affect_mean + positive_affect_sd +
                overall_pre_interest +
                (1|program_ID),
            data = df_ss)

sjPlot::sjt.lmer(m4i, p.kr = F, show.re.var = F, show.ci = F, show.se = T)

## Computing p-values via Wald-statistics approximation (treating t as Wald z).

	overall_post_interest
	B	std. Error	p
Fixed Parts
(Intercept)	0.79	0.27	.003
challenge_mean	-0.06	0.06	.303
challenge_sd	-0.50	0.13	<.001
learning_mean	0.57	0.11	<.001
learning_sd	0.06	0.13	.647
relevance_mean	-0.19	0.11	.092
relevance_sd	0.37	0.17	.033
overall_pre_interest	0.49	0.05	<.001
Random Parts
N_{program_ID}	9
ICC_{program_ID}	0.125
Observations	425
R² / Ω₀²	.487 / .486

m4ii <- lmer(post_future_goals_plans ~ 1 + 
                 challenge_mean + challenge_sd +
                 learning_mean + learning_sd +
                 relevance_mean + relevance_sd +
                 # positive_affect_mean + positive_affect_sd +
                 overall_pre_interest +
                 (1|program_ID),
             data = df_ss)

m4ii0 <- lmer(post_future_goals_plans ~
                  (1|program_ID),
              data = df_ss)

sjstats::icc(m4ii0)

## Linear mixed model
##  Family: gaussian (identity)
## Formula: post_future_goals_plans ~ (1 | program_ID)
## 
##   ICC (program_ID): 0.012007

sjPlot::sjt.lmer(m4ii, p.kr = F, show.re.var = F, show.ci = F, show.se = T)

## Computing p-values via Wald-statistics approximation (treating t as Wald z).

	post_future_goals_plans
	B	std. Error	p
Fixed Parts
(Intercept)	1.48	0.32	<.001
challenge_mean	-0.15	0.08	.051
challenge_sd	-0.05	0.16	.769
learning_mean	-0.11	0.14	.455
learning_sd	-0.28	0.16	.080
relevance_mean	0.53	0.15	<.001
relevance_sd	0.19	0.22	.385
overall_pre_interest	0.23	0.05	<.001
Random Parts
N_{program_ID}	9
ICC_{program_ID}	0.016
Observations	412
R² / Ω₀²	.169 / .169

4C. Predicting individual-level effects

library(magrittr)

## 
## Attaching package: 'magrittr'

## The following object is masked from 'package:purrr':
## 
##     set_names

## The following object is masked from 'package:tidyr':
## 
##     extract

# write a function at some point
# extract_ranef <- function(df, var, random_effect) {
#     
# }

x <- lmer(challenge ~ (1|program_ID) + (1|participant_ID) + (1|beep_ID_new), data = df) %>% 
    broom::tidy() %>% 
    filter(term == "(Intercept)") %>% 
    select(estimate)

chall_df <- lmer(challenge ~ (1|program_ID) + (1|participant_ID) + (1|beep_ID_new), data = df) %>% 
    ranef() %>% 
    extract2("participant_ID") %>% 
    rownames_to_column(var = "participant_ID") %>% 
    rename(pred_challenge = `(Intercept)`) %>%
    mutate(pred_challenge = pred_challenge + x[1, 1]) %>% 
    tbl_df()

x <- lmer(learning ~ (1|program_ID) + (1|participant_ID) + (1|beep_ID_new), data = df) %>% 
    broom::tidy() %>% 
    filter(term == "(Intercept)") %>% 
    select(estimate)

learning_df <- lmer(learning ~ (1|program_ID) + (1|participant_ID) + (1|beep_ID_new), data = df) %>% 
    ranef() %>% 
    extract2("participant_ID") %>% 
    rownames_to_column(var = "participant_ID") %>% 
    rename(pred_learning = `(Intercept)`) %>% 
    mutate(pred_learning = pred_learning + x[1, 1]) %>% 
    tbl_df()

x <- lmer(positive_affect ~ (1|program_ID) + (1|participant_ID) + (1|beep_ID_new), data = df) %>% 
    broom::tidy() %>% 
    filter(term == "(Intercept)") %>% 
    select(estimate)

positive_affect_df <- lmer(positive_affect ~ (1|program_ID) + (1|participant_ID) + (1|beep_ID_new), data = df) %>% 
    ranef() %>% 
    extract2("participant_ID") %>% 
    rownames_to_column(var = "participant_ID") %>% 
    rename(pred_positive_affect = `(Intercept)`) %>% 
    mutate(pred_positive_affect = pred_positive_affect + x[1, 1]) %>% 
    tbl_df()


x <- lmer(relevance ~ (1|program_ID) + (1|participant_ID) + (1|beep_ID_new), data = df) %>% 
    broom::tidy() %>% 
    filter(term == "(Intercept)") %>% 
    select(estimate)

relevance_df <- lmer(relevance ~ (1|program_ID) + (1|participant_ID) + (1|beep_ID_new), data = df) %>% 
    ranef() %>% 
    extract2("participant_ID") %>% 
    rownames_to_column(var = "participant_ID") %>% 
    rename(pred_relevance = `(Intercept)`) %>% 
    mutate(pred_relevance = pred_relevance + x[1, 1]) %>% 
    tbl_df()

# there's actually no variability at participant level:

pred_var_df <- chall_df %>% 
    left_join(learning_df, by = "participant_ID") %>% 
    left_join(positive_affect_df, by = "participant_ID") %>% 
    left_join(relevance_df, by = "participant_ID")

pre_survey_data_processed$participant_ID <- as.character(pre_survey_data_processed$participant_ID)
post_survey_data_partially_processed$participant_ID <- as.character(post_survey_data_partially_processed$participant_ID)
demographics$participant_ID <- as.character(demographics$participant_ID)

mod_df <- left_join(pred_var_df, pre_survey_data_processed, by = "participant_ID") %>% 
    left_join(post_survey_data_partially_processed, by = "participant_ID") %>% 
    left_join(demographics, by = "participant_ID")

4D. Using individual-level effects to predict post-interest and future goals and aspirations

m4bi <- lmer(overall_post_interest ~ 
                 pred_challenge + pred_learning + pred_relevance +
                 scale(overall_pre_interest, scale = F) + (1|program_ID), 
             data = mod_df)
sjPlot::sjt.lmer(m4bi, p.kr = F, show.re.var = F, show.ci = F, show.se = T)

## Computing p-values via Wald-statistics approximation (treating t as Wald z).

	overall_post_interest
	B	std. Error	p
Fixed Parts
(Intercept)	2.29	0.33	<.001
pred_challenge	-0.17	0.11	.141
pred_learning	0.55	0.23	.016
pred_relevance	-0.14	0.22	.513
scale(overall_pre_interest, scale = F)	0.54	0.08	<.001
Random Parts
N_{program_ID}	9
ICC_{program_ID}	0.064
Observations	142
R² / Ω₀²	.447 / .446

m4bii <- lmer(post_future_goals_plans ~ 
                  pred_challenge + pred_learning + pred_relevance +
                  scale(pre_future_goals_plans, scale = F) + (1|program_ID), 
              data = mod_df)
sjPlot::sjt.lmer(m4bii, p.kr = F, show.re.var = F, show.ci = F, show.se = T)

## Computing p-values via Wald-statistics approximation (treating t as Wald z).

	post_future_goals_plans
	B	std. Error	p
Fixed Parts
(Intercept)	2.14	0.38	<.001
pred_challenge	-0.11	0.13	.421
pred_learning	-0.08	0.27	.774
pred_relevance	0.43	0.26	.092
scale(pre_future_goals_plans, scale = F)	0.41	0.09	<.001
Random Parts
N_{program_ID}	9
ICC_{program_ID}	0.000
Observations	134
R² / Ω₀²	.268 / .268

STEM-IE Models

Joshua Rosenberg

02 October, 2017