Instructional Climate - Emotions

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 (not very robustly)
• Support for agency predicts:
  • positive affect
• Support for STEM skill-building predicts:
  • relevance
  • learning
• 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)

## Warning: package 'tibble' was built under R version 3.4.3

## Warning: package 'tidyr' was built under R version 3.4.3

library(lmerTest)

## Warning: package 'lmerTest' was built under R version 3.4.3

## Warning: package 'lme4' was built under R version 3.4.3

library(lme4)
library(corrr)
library(jmRtools)
library(gmodels)

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")
pre_survey_all_variables <- read_csv("/Volumes/SCHMIDTLAB/PSE/data/STEM-IE/STEM-IE-pre-survey-data-processed.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")
value <- read_csv("/Volumes/SCHMIDTLAB/PSE/Data/STEM-IE/STEM-IE-value.csv")
community_space <- read_csv("/Volumes/SCHMIDTLAB/PSE/Data/STEM-IE/STEM-IE-community-space-content.csv")

Creating motivation to attend variable

pre_survey_all_variables$motivation_to_attend <- ifelse(pre_survey_all_variables$how_much_looking_forward == 1, 0, 1)

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)

pre_survey_all_variables <- rename(pre_survey_all_variables, program_ID_string = program_ID)
pre_survey_all_variables <- rename(pre_survey_all_variables, program_providence_useless = program_providence)

df <- left_join(esm, pre_survey_data_processed, by = "participant_ID") # df = esm & pre-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
df <- left_join(df, pre_survey_all_variables, by = "participant_ID") #df & pre-survey all variables Not sure what two program id's now

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$stem_sb_dummy <- ifelse(pqa$stem_sb == 0, 0, 1)

# 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"))

## Warning: Column `program_ID` joining factor and character vector, coercing
## into character vector

# !!! MERGE PQA

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$program_ID <- as.character(pqa$program_ID)

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

# !!!

# !!! MERGE CLASS

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

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$program_ID <- as.character(class_data$SiteIDNumeric)

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

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

df <-left_join(df, pqa)
 
# !!!

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, sum_stem_sb, agency, active, belonging) %>% 
    correlate() %>% 
    shave() %>% 
    fashion() %>% 
    knitr::kable()

rowname	challenge	relevance	learning	positive_affect	ho_thinking	sum_stem_sb	agency	active	belonging
challenge
relevance	.39
learning	.30	.65
positive_affect	.27	.52	.48
ho_thinking	-.04	.02	.02	.03
sum_stem_sb	-.00	.02	.04	-.04	.53
agency	.06	.02	.04	.04	.38	.39
active	.01	.02	.03	.00	.44	.57	.16
belonging	.03	-.02	.03	-.01	.36	.42	.53	.23

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(sum_stem_sb > 0, 1, 0))

Creating subject variable

#pqa$subject <-ifelse(pqa$science == 1, "Science",
                     #ifelse(pqa$mathematics == 1, "Math",
                            #ifelse(pqa$building == 1, "Building", NA)))

df$subject <-ifelse(df$science == 1, "Science",
                     ifelse(df$mathematics == 1, "Math",
                            ifelse(df$building == 1, "Building", NA)))

df$subject_other <- ifelse(df$science == 0 &
                               df$mathematics == 0 &
                               df$building == 0, 1, 0)

Creating variable that is >=3

df$agency_comp_three <- ifelse(df$agency >= 3 & df$COMPOSIT >=3, 1, 0)

Joining Community Space data set

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

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



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

community_space$response_date <- format(as.Date(community_space$response_date, format = "%m/%d/%Y"), "%Y-%m-%d")

## Warning in strptime(x, format, tz = "GMT"): unknown timezone 'zone/tz/
## 2018c.1.0/zoneinfo/America/Detroit'

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

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

Joining Value data set

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

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

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

value$response_date <- format(as.Date(value$response_date, format = "%m/%d/%Y"), "%Y-%m-%d")

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

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

Creating variables for value

df$all_value_sum <- df$V01.01.HighUtility_sum + df$V01.03.HighIntrinsic_sum + df$V01.05.HighAttainment_sum

df$control <- jmRtools::composite_mean_maker(df, in_control, concentrating, learning, good_at)
df$value <- jmRtools::composite_mean_maker(df, important, future_goals)

Null Models

M0 <- lmer(control ~
             (1|program_ID) + 
             (1|participant_ID) + 
             (1|beep_ID_new),
           data = df)
summary(M0)

## Linear mixed model fit by REML ['lmerMod']
## Formula: 
## control ~ (1 | program_ID) + (1 | participant_ID) + (1 | beep_ID_new)
##    Data: df
## 
## REML criterion at convergence: 5846.1
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.4201 -0.4504  0.0882  0.5452  3.3410 
## 
## Random effects:
##  Groups         Name        Variance Std.Dev.
##  beep_ID_new    (Intercept) 0.01836  0.1355  
##  participant_ID (Intercept) 0.28203  0.5311  
##  program_ID     (Intercept) 0.00000  0.0000  
##  Residual                   0.34018  0.5832  
## Number of obs: 2970, groups:  
## beep_ID_new, 248; participant_ID, 203; program_ID, 9
## 
## Fixed effects:
##             Estimate Std. Error t value
## (Intercept)  2.84533    0.04027   70.66

sjstats::icc(M0)

## 
## Linear mixed model
##  Family: gaussian (identity)
## Formula: control ~ (1 | program_ID) + (1 | participant_ID) + (1 | beep_ID_new)
## 
##      ICC (beep_ID_new): 0.028660
##   ICC (participant_ID): 0.440285
##       ICC (program_ID): 0.000000

M01 <- lmer(value ~
             (1|program_ID) + 
             (1|participant_ID) + 
             (1|beep_ID_new),
           data = df)
summary(M01)

## Linear mixed model fit by REML ['lmerMod']
## Formula: 
## value ~ (1 | program_ID) + (1 | participant_ID) + (1 | beep_ID_new)
##    Data: df
## 
## REML criterion at convergence: 6925
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.7755 -0.5366  0.0545  0.6020  3.5370 
## 
## Random effects:
##  Groups         Name        Variance Std.Dev.
##  beep_ID_new    (Intercept) 0.018641 0.13653 
##  participant_ID (Intercept) 0.476102 0.69000 
##  program_ID     (Intercept) 0.005928 0.07699 
##  Residual                   0.488635 0.69902 
## Number of obs: 2970, groups:  
## beep_ID_new, 248; participant_ID, 203; program_ID, 9
## 
## Fixed effects:
##             Estimate Std. Error t value
## (Intercept)  2.56689    0.05782    44.4

sjstats::icc(M01)

## 
## Linear mixed model
##  Family: gaussian (identity)
## Formula: value ~ (1 | program_ID) + (1 | participant_ID) + (1 | beep_ID_new)
## 
##      ICC (beep_ID_new): 0.018843
##   ICC (participant_ID): 0.481249
##       ICC (program_ID): 0.005992

M02 <- lmer(happy ~
             (1|program_ID) + 
             (1|participant_ID) + 
             (1|beep_ID_new),
           data = df)
summary(M02)

## Linear mixed model fit by REML ['lmerMod']
## Formula: 
## happy ~ (1 | program_ID) + (1 | participant_ID) + (1 | beep_ID_new)
##    Data: df
## 
## REML criterion at convergence: 7605.5
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.4665 -0.4019  0.0595  0.5188  3.2445 
## 
## Random effects:
##  Groups         Name        Variance Std.Dev.
##  beep_ID_new    (Intercept) 0.0189   0.1375  
##  participant_ID (Intercept) 0.5047   0.7105  
##  program_ID     (Intercept) 0.1043   0.3230  
##  Residual                   0.6229   0.7893  
## Number of obs: 2969, groups:  
## beep_ID_new, 248; participant_ID, 203; program_ID, 9
## 
## Fixed effects:
##             Estimate Std. Error t value
## (Intercept)    2.799      0.121   23.14

sjstats::icc(M02)

## 
## Linear mixed model
##  Family: gaussian (identity)
## Formula: happy ~ (1 | program_ID) + (1 | participant_ID) + (1 | beep_ID_new)
## 
##      ICC (beep_ID_new): 0.015110
##   ICC (participant_ID): 0.403504
##       ICC (program_ID): 0.083398

M03 <- lmer(excited ~
             (1|program_ID) + 
             (1|participant_ID) + 
             (1|beep_ID_new),
           data = df)
summary(M03)

## Linear mixed model fit by REML ['lmerMod']
## Formula: 
## excited ~ (1 | program_ID) + (1 | participant_ID) + (1 | beep_ID_new)
##    Data: df
## 
## REML criterion at convergence: 8101.7
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.2302 -0.5459  0.0673  0.5932  3.1045 
## 
## Random effects:
##  Groups         Name        Variance Std.Dev.
##  beep_ID_new    (Intercept) 0.02962  0.1721  
##  participant_ID (Intercept) 0.54034  0.7351  
##  program_ID     (Intercept) 0.11483  0.3389  
##  Residual                   0.73599  0.8579  
## Number of obs: 2969, groups:  
## beep_ID_new, 248; participant_ID, 203; program_ID, 9
## 
## Fixed effects:
##             Estimate Std. Error t value
## (Intercept)   2.6018     0.1268   20.51

sjstats::icc(M03)

## 
## Linear mixed model
##  Family: gaussian (identity)
## Formula: excited ~ (1 | program_ID) + (1 | participant_ID) + (1 | beep_ID_new)
## 
##      ICC (beep_ID_new): 0.020847
##   ICC (participant_ID): 0.380310
##       ICC (program_ID): 0.080823

M04 <- lmer(frustrated ~
             (1|program_ID) + 
             (1|participant_ID) + 
             (1|beep_ID_new),
           data = df)
summary(M04)

## Linear mixed model fit by REML ['lmerMod']
## Formula: 
## frustrated ~ (1 | program_ID) + (1 | participant_ID) + (1 | beep_ID_new)
##    Data: df
## 
## REML criterion at convergence: 7789.7
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.9657 -0.5174 -0.1433  0.3808  3.3343 
## 
## Random effects:
##  Groups         Name        Variance Std.Dev.
##  beep_ID_new    (Intercept) 0.008871 0.09418 
##  participant_ID (Intercept) 0.503086 0.70929 
##  program_ID     (Intercept) 0.041607 0.20398 
##  Residual                   0.675877 0.82212 
## Number of obs: 2969, groups:  
## beep_ID_new, 248; participant_ID, 203; program_ID, 9
## 
## Fixed effects:
##             Estimate Std. Error t value
## (Intercept)  1.89567    0.08705   21.78

sjstats::icc(M04)

## 
## Linear mixed model
##  Family: gaussian (identity)
## Formula: frustrated ~ (1 | program_ID) + (1 | participant_ID) + (1 | beep_ID_new)
## 
##      ICC (beep_ID_new): 0.007215
##   ICC (participant_ID): 0.409199
##       ICC (program_ID): 0.033842

M05 <- lmer(bored ~
             (1|program_ID) + 
             (1|participant_ID) + 
             (1|beep_ID_new),
           data = df)
summary(M05)

## Linear mixed model fit by REML ['lmerMod']
## Formula: 
## bored ~ (1 | program_ID) + (1 | participant_ID) + (1 | beep_ID_new)
##    Data: df
## 
## REML criterion at convergence: 8288.4
## 
## Scaled residuals: 
##      Min       1Q   Median       3Q      Max 
## -2.97201 -0.61796 -0.09737  0.48698  3.08594 
## 
## Random effects:
##  Groups         Name        Variance Std.Dev.
##  beep_ID_new    (Intercept) 0.03174  0.1782  
##  participant_ID (Intercept) 0.53709  0.7329  
##  program_ID     (Intercept) 0.08910  0.2985  
##  Residual                   0.78770  0.8875  
## Number of obs: 2969, groups:  
## beep_ID_new, 248; participant_ID, 203; program_ID, 9
## 
## Fixed effects:
##             Estimate Std. Error t value
## (Intercept)    2.155      0.115   18.74

sjstats::icc(M05)

## 
## Linear mixed model
##  Family: gaussian (identity)
## Formula: bored ~ (1 | program_ID) + (1 | participant_ID) + (1 | beep_ID_new)
## 
##      ICC (beep_ID_new): 0.021959
##   ICC (participant_ID): 0.371529
##       ICC (program_ID): 0.061631