RQ_1

This is analysis associated with the first RQ for the STEM-IE project.

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

• This is more about what are the activities that are challenging and relevant in order to understand what program-level characteristics predict these experience.

• We think it could be useful for evaluation and feedback purposes - this is more a background question that we want to be able to use to inform programs in terms of what activities may be challenging and relevant
  • this focuses should be on things that programs can control.

This is what we know:

• Basic skills predicts:
  • challenge (not very robustly)
  • learning (robustly)
• Creating products predicts:
  • challenge (fairly robustly)
  • relevance
  • learning
• Support for agency predicts:
  • positive affect
• Support for STEM skill-building predicts:
  • relevance
  • positive affect
• Minor findings:
  • HO thinking seems to negatively predict challenge

This is what we want to figure out:

• How reliably was the PQA used videos?
• Can we use dummy codes instead of counts for PQA measures?

How this document is organized

• The outcomes are numbered 1 - 4 (challenge, relevance, learning, and positive affect)
• Within the section for each outcome, four models are specified (just youth activity, PQA counts, PQA dummy codes, and select activities with select PQA counts)

library(tidyverse)
library(lme4)
library(corrr)
library(jmRtools)
library(sjPlot)

esm <- read_csv("/Volumes/SCHMIDTLAB/PSE/data/STEM-IE/STEM-IE-esm.csv")
pre_survey_data_processed <- read_csv("/Volumes/SCHMIDTLAB/PSE/data/STEM-IE/STEM-IE-pre-survey.csv")
post_survey_data_partially_processed <- read_csv("/Volumes/SCHMIDTLAB/PSE/data/STEM-IE/STEM-IE-post-survey.csv")
video <- read_csv("/Volumes/SCHMIDTLAB/PSE/data/STEM-IE/STEM-IE-video.csv")
pqa <- read_csv("/Volumes/SCHMIDTLAB/PSE/data/STEM-IE/STEM-IE-pqa.csv")
attendance <- read_csv("/Volumes/SCHMIDTLAB/PSE/data/STEM-IE/STEM-IE-attendance.csv")
class_data <- read_csv("/Volumes/SCHMIDTLAB/PSE/data/STEM-IE/STEM-IE-class-video.csv")
demographics <- read_csv("/Volumes/SCHMIDTLAB/PSE/data/STEM-IE/STEM-IE-demographics.csv")
pm <- read_csv("/Volumes/SCHMIDTLAB/PSE/Data/STEM-IE/STEM-IE-program-match.csv")

attendance <- rename(attendance, participant_ID = ParticipantID)
attendance <- mutate(attendance, prop_attend = DaysAttended / DaysScheduled, 
                     participant_ID = as.integer(participant_ID))
attendance <- select(attendance, participant_ID, prop_attend)

demographics <- filter(demographics, participant_ID!= 7187)
demographics <- left_join(demographics, attendance)

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

df <- left_join(esm, pre_survey_data_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

pqa <- mutate(pqa, 
              active = active_part_1 + active_part_2,
              ho_thinking = ho_thinking_1 + ho_thinking_2 + ho_thinking_3,
              belonging = belonging_1 + belonging_2,
              agency = agency_1 + agency_2 + agency_3 + agency_4,
              youth_development_overall = active_part_1 + active_part_2 + ho_thinking_1 + ho_thinking_2 + ho_thinking_3 + belonging_1 + belonging_2 + agency_1 + agency_2 + agency_3 + agency_4,
              making_observations = stem_sb_8,
              data_modeling = stem_sb_2 + stem_sb_3 + stem_sb_9,
              interpreting_communicating = stem_sb_6,
              generating_data = stem_sb_4,
              asking_questions = stem_sb_1,
              stem_sb = stem_sb_1 + stem_sb_2 + stem_sb_3 + stem_sb_4 + stem_sb_5 + stem_sb_6 + stem_sb_7 + stem_sb_8 + stem_sb_9)

# pqa <- rename(pqa, sixth_math_sociedad = sixth_math)
# pqa <- rename(pqa, seventh_math_sociedad = seventh_math)
# pqa <- rename(pqa, eighth_math_sociedad = eighth_math)
# pqa <- rename(pqa, dance_sociedad = dance)
# pqa <- rename(pqa, robotics_sociedad = robotics)

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

pqa <- rename(pqa, 
              program_ID = SiteIDNumeric,
              response_date = resp_date,
              signal_number = signal)

pqa$program_ID <- as.character(pqa$program_ID)

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

df <- df %>% 
    mutate(youth_activity_three = case_when(
        youth_activity_rc == "Creating Product" ~ "Creating Product",
        youth_activity_rc == "Basic Skills Activity" ~ "Basic Skills Activity",
        TRUE ~ "Other"
    ))

df$youth_activity_three <- fct_relevel(df$youth_activity_three, 
                                       "Other")

Correlations

df %>% 
    select(challenge, relevance, learning, positive_affect, ho_thinking, stem_sb, agency, active, belonging) %>% 
    correlate() %>% 
    shave() %>% 
    fashion() %>% 
    knitr::kable()

rowname	challenge	relevance	learning	positive_affect	ho_thinking	stem_sb	agency	active	belonging
challenge
relevance	.39
learning	.30	.65
positive_affect	.27	.52	.48
ho_thinking	-.04	.02	.02	.04
stem_sb	.00	.02	.04	-.04	.54
agency	.06	.02	.04	.04	.38	.39
active	.01	.02	.03	.00	.44	.56	.16
belonging	.03	-.02	.03	-.01	.36	.42	.54	.22

df <- df %>% 
    mutate(ho_thinking_dummy = ifelse(ho_thinking > 0, 1, 0),
           agency_dummy = ifelse(agency > 0, 1, 0),
           active_dummy = ifelse(active > 0, 1, 0),
           belonging_dummy = ifelse(belonging > 0, 1, 0),
           stem_sb_dummy = ifelse(stem_sb > 0, 1, 0))

1. Challenge

1A: Just youth activity

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

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

		challenge
		B	std. Error	p
Fixed Parts
(Intercept)		2.19	0.09	<.001
youth_activity_rc (Basic Skills Activity)		0.10	0.06	.151
youth_activity_rc (Creating Product)		0.37	0.06	<.001
youth_activity_rc (Field Trip Speaker)		-0.08	0.13	.565
youth_activity_rc (Lab Activity)		0.20	0.12	.136
youth_activity_rc (Program Staff Led)		-0.10	0.07	.205
Random Parts
Nbeep_ID_new		235
Nparticipant_ID		203
Nprogram_ID		9
ICCbeep_ID_new		0.045
ICCparticipant_ID		0.385
ICCprogram_ID		0.034
Observations		2818
R2 / Ω02		.529 / .522

1B: Just STEM-SB as counts

m <- lmer(challenge ~ 
              active +
              ho_thinking +
              belonging +
              agency +
              stem_sb + 
              (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
          data = df)

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

		challenge
		B	std. Error	p
Fixed Parts
(Intercept)		2.17	0.12	<.001
active		0.03	0.06	.642
ho_thinking		-0.09	0.03	.004
belonging		0.05	0.04	.221
agency		0.07	0.02	.005
stem_sb		0.02	0.01	.181
Random Parts
Nbeep_ID_new		236
Nparticipant_ID		203
Nprogram_ID		9
ICCbeep_ID_new		0.051
ICCparticipant_ID		0.375
ICCprogram_ID		0.042
Observations		2799
R2 / Ω02		.529 / .521

1C: Just STEM-SB as dummy codes (if count >= 1, then dummy code = 1)

m <- lmer(challenge ~ 
              active_dummy +
              ho_thinking_dummy +
              belonging_dummy +
              agency_dummy +
              stem_sb_dummy + 
              (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
          data = df)

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

		challenge
		B	std. Error	p
Fixed Parts
(Intercept)		1.98	0.21	<.001
active_dummy		0.12	0.19	.532
ho_thinking_dummy		-0.15	0.08	.047
belonging_dummy		0.11	0.07	.084
agency_dummy		0.14	0.07	.056
stem_sb_dummy		0.14	0.07	.056
Random Parts
Nbeep_ID_new		236
Nparticipant_ID		203
Nprogram_ID		9
ICCbeep_ID_new		0.057
ICCparticipant_ID		0.373
ICCprogram_ID		0.041
Observations		2799
R2 / Ω02		.530 / .523

1D: Only select activities and STEM-SB dummy codes

m <- lmer(challenge ~ 
              youth_activity_three +
              agency_dummy +
              stem_sb_dummy + 
              (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
          data = df)

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

		challenge
		B	std. Error	p
Fixed Parts
(Intercept)		2.08	0.11	<.001
youth_activity_three (Basic Skills Activity)		0.13	0.06	.047
youth_activity_three (Creating Product)		0.36	0.06	<.001
agency_dummy		0.08	0.06	.195
stem_sb_dummy		0.04	0.06	.546
Random Parts
Nbeep_ID_new		236
Nparticipant_ID		203
Nprogram_ID		9
ICCbeep_ID_new		0.047
ICCparticipant_ID		0.379
ICCprogram_ID		0.039
Observations		2799
R2 / Ω02		.528 / .521

2. Relevance

2A: Just youth activity

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

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

		relevance
		B	std. Error	p
Fixed Parts
(Intercept)		2.46	0.07	<.001
youth_activity_rc (Basic Skills Activity)		0.15	0.04	.005
youth_activity_rc (Creating Product)		0.23	0.04	<.001
youth_activity_rc (Field Trip Speaker)		0.29	0.07	.004
youth_activity_rc (Lab Activity)		0.11	0.07	.182
youth_activity_rc (Program Staff Led)		0.15	0.04	.009
Random Parts
Nbeep_ID_new		235
Nparticipant_ID		203
Nprogram_ID		9
ICCbeep_ID_new		0.007
ICCparticipant_ID		0.523
ICCprogram_ID		0.016
Observations		2818
R2 / Ω02		.586 / .583

2B: Just STEM-SB as counts

m <- lmer(relevance ~ 
              active +
              ho_thinking +
              belonging +
              agency +
              stem_sb + 
              (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
          data = df)

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

		relevance
		B	std. Error	p
Fixed Parts
(Intercept)		2.50	0.08	<.001
active		0.02	0.03	.552
ho_thinking		0.01	0.02	.479
belonging		-0.04	0.02	.144
agency		0.01	0.01	.644
stem_sb		0.02	0.01	.072
Random Parts
Nbeep_ID_new		236
Nparticipant_ID		203
Nprogram_ID		9
ICCbeep_ID_new		0.012
ICCparticipant_ID		0.516
ICCprogram_ID		0.014
Observations		2799
R2 / Ω02		.586 / .584

2C: Just STEM-SB as dummy codes (if count >= 1, then dummy code = 1)

m <- lmer(relevance ~ 
              active_dummy +
              ho_thinking_dummy +
              belonging_dummy +
              agency_dummy +
              stem_sb_dummy + 
              (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
          data = df)

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

		relevance
		B	std. Error	p
Fixed Parts
(Intercept)		2.32	0.13	<.001
active_dummy		0.21	0.12	.082
ho_thinking_dummy		-0.08	0.05	.109
belonging_dummy		0.01	0.04	.707
agency_dummy		-0.00	0.04	.955
stem_sb_dummy		0.13	0.04	.003
Random Parts
Nbeep_ID_new		236
Nparticipant_ID		203
Nprogram_ID		9
ICCbeep_ID_new		0.012
ICCparticipant_ID		0.520
ICCprogram_ID		0.009
Observations		2799
R2 / Ω02		.587 / .584

2D: Only select activities and STEM-SB dummy codes

m <- lmer(relevance ~ 
              youth_activity_three +
              agency_dummy +
              stem_sb_dummy + 
              (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
          data = df)

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

		relevance
		B	std. Error	p
Fixed Parts
(Intercept)		2.49	0.07	<.001
youth_activity_three (Basic Skills Activity)		0.05	0.04	.157
youth_activity_three (Creating Product)		0.15	0.04	.001
agency_dummy		-0.04	0.04	.300
stem_sb_dummy		0.10	0.04	.022
Random Parts
Nbeep_ID_new		236
Nparticipant_ID		203
Nprogram_ID		9
ICCbeep_ID_new		0.010
ICCparticipant_ID		0.522
ICCprogram_ID		0.008
Observations		2799
R2 / Ω02		.586 / .583

3. Learning

3A: Just youth activity

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

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

		learning
		B	std. Error	p
Fixed Parts
(Intercept)		2.68	0.06	<.001
youth_activity_rc (Basic Skills Activity)		0.22	0.05	.002
youth_activity_rc (Creating Product)		0.14	0.05	.028
youth_activity_rc (Field Trip Speaker)		0.10	0.10	.339
youth_activity_rc (Lab Activity)		0.15	0.10	.145
youth_activity_rc (Program Staff Led)		0.07	0.06	.250
Random Parts
Nbeep_ID_new		235
Nparticipant_ID		203
Nprogram_ID		9
ICCbeep_ID_new		0.011
ICCparticipant_ID		0.357
ICCprogram_ID		0.002
Observations		2817
R2 / Ω02		.428 / .421

3B: Just STEM-SB as counts

m <- lmer(learning ~ 
              active +
              ho_thinking +
              belonging +
              agency +
              stem_sb + 
              (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
          data = df)

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

		learning
		B	std. Error	p
Fixed Parts
(Intercept)		2.63	0.08	<.001
active		0.08	0.04	.071
ho_thinking		-0.03	0.02	.241
belonging		0.03	0.03	.280
agency		0.01	0.02	.547
stem_sb		0.01	0.01	.491
Random Parts
Nbeep_ID_new		236
Nparticipant_ID		203
Nprogram_ID		9
ICCbeep_ID_new		0.012
ICCparticipant_ID		0.356
ICCprogram_ID		0.000
Observations		2798
R2 / Ω02		.427 / .420

3C: Just STEM-SB as dummy codes (if count >= 1, then dummy code = 1)

m <- lmer(learning ~ 
              active_dummy +
              ho_thinking_dummy +
              belonging_dummy +
              agency_dummy +
              stem_sb_dummy + 
              (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
          data = df)

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

		learning
		B	std. Error	p
Fixed Parts
(Intercept)		2.33	0.15	<.001
active_dummy		0.34	0.15	.022
ho_thinking_dummy		-0.09	0.06	.123
belonging_dummy		0.08	0.05	.116
agency_dummy		0.02	0.05	.664
stem_sb_dummy		0.13	0.05	.015
Random Parts
Nbeep_ID_new		236
Nparticipant_ID		203
Nprogram_ID		9
ICCbeep_ID_new		0.011
ICCparticipant_ID		0.357
ICCprogram_ID		0.000
Observations		2798
R2 / Ω02		.428 / .421

3D: Only select activities and STEM-SB dummy codes

m <- lmer(learning ~ 
              youth_activity_three +
              agency_dummy +
              stem_sb_dummy + 
              (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
          data = df)

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

		learning
		B	std. Error	p
Fixed Parts
(Intercept)		2.62	0.07	<.001
youth_activity_three (Basic Skills Activity)		0.16	0.05	.002
youth_activity_three (Creating Product)		0.06	0.05	.208
agency_dummy		0.04	0.05	.435
stem_sb_dummy		0.10	0.05	.062
Random Parts
Nbeep_ID_new		236
Nparticipant_ID		203
Nprogram_ID		9
ICCbeep_ID_new		0.010
ICCparticipant_ID		0.357
ICCprogram_ID		0.001
Observations		2798
R2 / Ω02		.426 / .420

4. Affect

4A: Just youth activity

m <- lmer(positive_affect ~ 
              youth_activity_rc + 
              (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
          data = df)

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

		positive_affect
		B	std. Error	p
Fixed Parts
(Intercept)		2.70	0.12	<.001
youth_activity_rc (Basic Skills Activity)		0.03	0.05	.548
youth_activity_rc (Creating Product)		0.01	0.05	.808
youth_activity_rc (Field Trip Speaker)		0.01	0.10	.928
youth_activity_rc (Lab Activity)		0.07	0.10	.527
youth_activity_rc (Program Staff Led)		-0.05	0.06	.403
Random Parts
Nbeep_ID_new		235
Nparticipant_ID		203
Nprogram_ID		9
ICCbeep_ID_new		0.023
ICCparticipant_ID		0.421
ICCprogram_ID		0.091
Observations		2818
R2 / Ω02		.580 / .576

4B: Just STEM-SB as counts

m <- lmer(positive_affect ~ 
              active +
              ho_thinking +
              belonging +
              agency +
              stem_sb + 
              (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
          data = df)

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

		positive_affect
		B	std. Error	p
Fixed Parts
(Intercept)		2.63	0.13	<.001
active		0.05	0.04	.300
ho_thinking		-0.00	0.02	.880
belonging		0.03	0.03	.300
agency		0.02	0.02	.346
stem_sb		-0.02	0.01	.107
Random Parts
Nbeep_ID_new		236
Nparticipant_ID		203
Nprogram_ID		9
ICCbeep_ID_new		0.023
ICCparticipant_ID		0.424
ICCprogram_ID		0.091
Observations		2799
R2 / Ω02		.584 / .580

4C: Just STEM-SB as dummy codes (if count >= 1, then dummy code = 1)

m <- lmer(positive_affect ~ 
              active_dummy +
              ho_thinking +
              belonging_dummy +
              agency_dummy +
              stem_sb_dummy +
              (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
          data = df)

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

		positive_affect
		B	std. Error	p
Fixed Parts
(Intercept)		2.62	0.19	<.001
active_dummy		-0.00	0.15	.975
ho_thinking		-0.01	0.02	.531
belonging_dummy		0.04	0.05	.403
agency_dummy		0.13	0.05	.021
stem_sb_dummy		-0.03	0.06	.611
Random Parts
Nbeep_ID_new		236
Nparticipant_ID		203
Nprogram_ID		9
ICCbeep_ID_new		0.023
ICCparticipant_ID		0.423
ICCprogram_ID		0.093
Observations		2799
R2 / Ω02		.584 / .580

4D: Only select activities and STEM-SB dummy codes

m <- lmer(positive_affect ~ 
              youth_activity_three +
              agency_dummy +
              stem_sb_dummy + 
              (1|program_ID) + (1|participant_ID) + (1|beep_ID_new),
          data = df)

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

		positive_affect
		B	std. Error	p
Fixed Parts
(Intercept)		2.62	0.13	<.001
youth_activity_three (Basic Skills Activity)		0.04	0.05	.434
youth_activity_three (Creating Product)		-0.03	0.05	.590
agency_dummy		0.15	0.05	.012
stem_sb_dummy		-0.05	0.05	.366
Random Parts
Nbeep_ID_new		236
Nparticipant_ID		203
Nprogram_ID		9
ICCbeep_ID_new		0.022
ICCparticipant_ID		0.423
ICCprogram_ID		0.095
Observations		2799
R2 / Ω02		.584 / .580