#This section is meant to clean the data and produce a list for instructors to use for grade assignment
#Creating list of students to contact
head(data)
data<- data |> filter(Q0.1=="Yes") #selcting for only students who agree to participate
nrow(data)
data
contact<- data |> filter(Q0.2=="Yes") #this will only include students who want to be contacted about interviews
nrow(contact)
match.contact<- match(emails,roster$Email)
sum(is.na(match.contact)) #this is a check to see if there are any emails that did not match
full.contact<-data.frame("first name" = roster$Student_first_Name[match.contact], "last name" = roster$Student_Last_Name[match.contact], email = emails, section = roster$Sctn_Code[match.contact] )
nrow(full.contact)
full.contact<- full.contact[order(full.contact$section),]
full.contact
sum(is.na(match.contact))
emails[is.na(match.contact)]
write.csv(full.contact, "Interview email list.csv", row.names = FALSE)
#Cleaning the data
data
class(data$Q3)
data <- data |>
mutate(across(Q3:Q45, ~ case_when(
. == "strongly disagree" ~ 5,
. == "disagree" ~ 4,
. == "neutral" ~ 3,
. == "agree" ~ 2,
. == "strongly agree" ~ 1,
TRUE ~ NA_real_)))
class(data$Q3)
sum(is.na(data))
#LPA
library(purrr)
## Warning: package 'purrr' was built under R version 4.5.3
library(lavaan)
## Warning: package 'lavaan' was built under R version 4.5.3
## This is lavaan 0.6-21
## lavaan is FREE software! Please report any bugs.
library(psych)
## Warning: package 'psych' was built under R version 4.5.3
##
## Attaching package: 'psych'
## The following object is masked from 'package:lavaan':
##
## cor2cov
library(here)
## Warning: package 'here' was built under R version 4.5.3
## here() starts at C:/Users/garre/OneDrive/Desktop/Motivation/FS26 Surveys
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.5.3
##
## Attaching package: 'ggplot2'
## The following objects are masked from 'package:psych':
##
## %+%, alpha
library(tidyr)
## Warning: package 'tidyr' was built under R version 4.5.3
library(tidyLPA)
## Warning: package 'tidyLPA' was built under R version 4.5.3
## Loading required package: tidySEM
## Warning: package 'tidySEM' was built under R version 4.5.3
## Registered S3 method overwritten by 'tidyLPA':
## method from
## print.LRT tidySEM
## You can use the function citation('tidyLPA') to create a citation for the use of {tidyLPA}.
## Mplus is not installed. Use only package = 'mclust' when calling estimate_profiles().
##
## Attaching package: 'tidyLPA'
## The following objects are masked from 'package:tidySEM':
##
## get_data, get_estimates, get_fit, poms
library(dplyr)
LPA <- data |>
mutate(
SE = rowMeans(pick("Q7","Q14", "Q26", "Q35", "Q44"), na.rm = TRUE),
IV = rowMeans(pick("Q8", "Q22", "Q29", "Q38","Q40"), na.rm = TRUE),
UV = rowMeans(pick("Q9", "Q18", "Q23", "Q27","Q30"), na.rm = TRUE),
AV = rowMeans(pick("Q6", "Q15", "Q36", "Q41","Q45"), na.rm = TRUE),
PC = rowMeans(pick("Q13", "Q19", "Q24", "Q34","Q37"), na.rm = TRUE),
EC = rowMeans(pick("Q5", "Q10", "Q21", "Q31",), na.rm = TRUE),
OC = rowMeans(pick("Q12", "Q17", "Q28", "Q33"), na.rm = TRUE),
M = rowMeans(pick("Q3", "Q16", "Q20", "Q32","Q43"), na.rm = TRUE),
PAP = rowMeans(pick("Q4", "Q11", "Q25", "Q39","Q42"), na.rm = TRUE)
) |>
select(SE, IV, UV, AV, PC, EC, OC, M, PAP) |>
single_imputation() |>
scale() |>
estimate_profiles(4:7)
LPA
compare_solutions(LPA, statistics = c("AIC", "BIC"))
## Warning: The solution with the minimum number of classes under consideration
## was considered to be the best solution according to one or more fit indices.
## Examine your results with care; consider adding a smaller number of classes.
LPA.FIG<- get_data(LPA[[4]]) #this is calling the fourth model/ 7 classes
LPA_long <- LPA.FIG %>%
select(Class, SE:PAP) %>%
pivot_longer(
cols = SE:PAP,
names_to = "scale",
values_to = "Estimate"
)
LPA_summary <- LPA_long %>%
group_by(Class, scale) %>%
summarise(
mean = mean(Estimate, na.rm = TRUE),
sd = sd(Estimate, na.rm = TRUE),
n = n(),
se = sd / sqrt(n),
lower = mean - 1.96 * se,
upper = mean + 1.96 * se,
.groups = "drop"
)
LPA_summary$scale <- factor(
LPA_summary$scale,
levels = c(
"SE",
"IV",
"UV",
"AV",
"PC",
"EC",
"OC",
"M",
"PAP"
)
)
names(data)
##----This code is of concern. Will this provide me with an accurate match of students and their class?----
class_members <- LPA.FIG %>%
mutate(ID = row_number()) %>%
left_join(
data %>%
mutate(ID = row_number()) %>%
select(ID, Q1, Q2, Q46),
by = "ID") %>%
select(Class, Q1, Q2, Q46)
class_members
data
LPA.FIG %>%
count(Class) %>%
mutate(percent = round(n / sum(n) * 100, 1))
ggplot(LPA_summary, aes(x = scale, y = mean, fill = scale)) +
geom_col(width = 0.7) +
geom_errorbar(
aes(ymin = lower, ymax = upper),
width = 0.15,
color = "black"
) +
facet_wrap(~ Class) +
scale_fill_viridis_d(option = "D") +
labs(
y = "Standardized Score",
title = "FS26 Motivational Profile Means with 95% Confidence Intervals"
) +
theme_minimal() +
theme(
legend.position = "right",
plot.title = element_text(
hjust = 0.5,
size= 25),
axis.title.y = element_text(
size = 18
),
legend.text = element_text(
size = 16
),
legend.title = element_text(
size = 18
),
axis.text.x = element_blank(),
axis.ticks.x = element_blank(),
axis.title.x = element_blank()
)
LPA.FIG %>%
count(Class) %>%
mutate(percent = n / sum(n) * 100)
#--- saving in high quality---
ggsave(
"LPA.fig.png",
width = 12,
height = 7,
dpi = 600
)