ProjectAnalysis
Sophie Buysse
2024-07-01
Goal
The goal of this code is to do all the data cleaning, subsetting, and calculating of differences to prepare for doing statistical analysis. When that is completed, this code will analyze difference in science literacy scores by section and by those students who completed the modelling activity and those who did not. It will also break down science literacy score changes into 9 specific science literacy skills. Finally, it will look for a relationship between group mean science literacy scores and group final presentation scores to identify if students with higher science literacy are better able to present their experimental results and significance.
The data read into this document was anonymized by someone outside the research team before analysis, but they did not exclude any data during the anonymization process.
Install Packages
library(dplyr)
library(ggplot2)
library(lubridate)
library(lme4)
library(ggpubr)
library(lmerTest)Filter Data
Filter data by individuals who consented to be in the research study
during both the pre and post assessment:
251 students consented to be included in the study from 4 recitation sections.
Exclude any students who completed the pre or post science literacy survey in less than 10 minutes, the time it takes for me to read through all the included text on the survey. Some students took a long time becuase there was no time limit, and if they leave the survey open on their computer the time keeps counting up. left these students in.
Of the 251 students who consented and took both the pre and the post, 6 of them were too speedy with the pre so they were cut.
Overall, did modelling impact science literacy?
Calculate Score Percentages
pre_tot$pre_perc <- pre_tot$Score / pre_tot$Out.Of
pre_tot <- pre_tot %>%
rename(pre_score = Score)
max(pre_tot$pre_score)## [1] 28min(pre_tot$pre_score)## [1] 3mean(pre_tot$pre_score)## [1] 19.65714ggplot(pre_tot, aes(x=pre_score))+
geom_histogram(binwidth=2, color = "black", fill = "grey90")+
geom_vline(aes(xintercept=mean(pre_score)),
color="black", linetype="dashed", size=1)+
theme_classic()## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
#NOTE: in the below code, the line drawn is the OVERALL MEAN. it is NOT the mean for each section.
ggplot(pre_tot, aes(x=pre_score, ))+
geom_histogram(binwidth=2, aes(color=Sctn_Code, fill = Sctn_Code), alpha = 0.5, position = "identity")+
geom_vline(aes(xintercept=mean(pre_score)),
color="black", linetype="dashed", size=1)+
facet_grid(. ~ Sctn_Code)+
theme_classic()
pre_tot %>%
group_by(Sctn_Code) %>%
summarize(mean_pre = mean(pre_score, na.rm = TRUE), num = n())## # A tibble: 4 × 3
## Sctn_Code mean_pre num
## <chr> <dbl> <int>
## 1 REC1 19.9 65
## 2 REC2 19.2 62
## 3 REC3 19.7 81
## 4 REC4 19.9 37post_tot$post_perc <- post_tot$Score / post_tot$Out.Of
post_tot <- post_tot %>%
rename(post_score = Score)
max(post_tot$post_score)## [1] 28min(post_tot$post_score)## [1] 8mean(post_tot$post_score)## [1] 20.29084ggplot(post_tot, aes(x=post_score))+
geom_histogram(binwidth=2, color = "black", fill = "grey90")+
geom_vline(aes(xintercept=mean(post_score)),
color="black", linetype="dashed", size=1)+
theme_classic()
# line drawn is again the overall mean
ggplot(post_tot, aes(x=post_score, ))+
geom_histogram(binwidth=2, aes(color=Sctn_Code, fill = Sctn_Code), alpha = 0.5, position = "identity")+
geom_vline(aes(xintercept=mean(post_score)),
color="black", linetype="dashed", size=1)+
facet_grid(. ~ Sctn_Code)+
theme_classic()
post_tot %>%
group_by(Sctn_Code) %>%
summarize(mean_post = mean(post_score, na.rm = TRUE), num = n())## # A tibble: 4 × 3
## Sctn_Code mean_post num
## <chr> <dbl> <int>
## 1 REC1 20.6 69
## 2 REC2 20.2 63
## 3 REC3 20.1 82
## 4 REC4 20.3 37Summarize difference by section and model completed yes/no
All_summary <- merge(pre_tot, post_tot, by = c("Random_Number", "Out.Of", "Sctn_Code", "Sctn_Id_Code"), all.x = TRUE, all.y = FALSE)
# some folks didn't do pre and post; all.y = FALSE gets rid of the 6 individuals who were too speedy on the pre
All_summary$dif_score <- All_summary$post_score - All_summary$pre_score
All_summary$dif_perc <- All_summary$post_perc - All_summary$pre_perc
# quick look
hist(All_summary$dif_score)
# add model information. note: this assumes everyone came to class the day the activity was completed.
All_summary$model <- "no"
All_summary[All_summary$Sctn_Code %in% c("REC2", "REC4"), "model"] <- "yes"
# order factors - do this way so works for all figures
All_summary$model <- factor(All_summary$model, levels = c("yes", "no"))
# summarize by section
All_summary %>%
group_by(Sctn_Code) %>%
summarize(mean_dif = mean(dif_score, na.rm = TRUE))## # A tibble: 4 × 2
## Sctn_Code mean_dif
## <chr> <dbl>
## 1 REC1 0.831
## 2 REC2 1.08
## 3 REC3 0.469
## 4 REC4 0.378# rec 1 and 2 went down more than 3 and 4
ggplot(All_summary, aes(x=dif_score))+
geom_histogram(binwidth=2, color = "black", fill = "grey90")+
geom_vline(aes(xintercept=mean(dif_score)),
color="black", linetype="dashed", size=1)+
theme_classic()
ggplot(All_summary, aes(x=dif_score, ))+
geom_histogram(binwidth=2, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
# summarize by modelling activity
All_summary %>%
group_by(model) %>%
summarize(mean_dif = mean(dif_score, na.rm = TRUE))## # A tibble: 2 × 2
## model mean_dif
## <fct> <dbl>
## 1 yes 0.818
## 2 no 0.630# yes went down more than no
ggplot(All_summary, aes(x=dif_score, ))+
geom_histogram(binwidth=2, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ model)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
#Merge in final presentation score info
All_summary <- merge(All_summary, pres_score, by = "Random_Number", all.x = TRUE)
# make Pres score a percentage
All_summary$pres_perc <- All_summary$FinalPresScores / 25
ggplot(All_summary, aes(x=FinalPresScores))+
geom_histogram(binwidth=2, color = "black", fill = "grey90")+
geom_vline(aes(xintercept=mean(FinalPresScores)),
color="black", linetype="dashed", size=1)+
theme_classic()
# by section
All_summary %>%
group_by(Sctn_Code) %>%
summarize(mean_pres = mean(FinalPresScores, na.rm = TRUE), num = n())## # A tibble: 4 × 3
## Sctn_Code mean_pres num
## <chr> <dbl> <int>
## 1 REC1 22.2 65
## 2 REC2 22.6 62
## 3 REC3 21.7 81
## 4 REC4 20.7 37# sec 1 and 2 have higher score, then 3, then 4
ggplot(All_summary, aes(x=FinalPresScores, ))+
geom_histogram(binwidth=2, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
# by modelling
All_summary %>%
group_by(model) %>%
summarize(mean_pres = mean(FinalPresScores, na.rm = TRUE), num = n())## # A tibble: 2 × 3
## model mean_pres num
## <fct> <dbl> <int>
## 1 yes 21.9 99
## 2 no 21.9 146# very similar
ggplot(All_summary, aes(x=FinalPresScores, ))+
geom_histogram(binwidth=2, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ model)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
To summarize, Sections 1 and 2 increased their science literacy scores but scored higher on the final presentation. Sections 3 and 4 also increased science literacy and had lower presentation scores. Sections 2 and 4 completed the modelling activity; students who completed the modeling activity had a slightly greater increase in science literacy than students who did not, but final presentation scores are very comparable.
Statistics
Use a t-test to look for a difference in overall pre/post scores and for a difference in score changes between students who completed the modelling activity and those who did not.
I am interested in differences between sections that got the modelling activity and sections that did not get the modelling activity. Nested section within model should be a random effect because that is variation that I am not interested in analyzing. So I want to run models to predict pre_perc, post_perc, dif_perc, and pres_perc. Doing all as percentages for ease of comparison.
Note for future analysis: Could also have their individual lab section as a random effect nested within recitation section. Would need to go back to randomization step from the outside person to have this data included. Other feedback I have gotten is to remember that students with an already high science literacy score have less available space to increase their scores. Because pre scores were
# are the scores correlated?
cor(All_summary$post_perc, All_summary$pre_perc, method = "pearson")## [1] 0.6291202plot(All_summary$pre_perc, All_summary$post_perc)
cor(All_summary$post_perc, All_summary$dif_perc, method = "pearson")## [1] 0.3127566plot(All_summary$post_perc, All_summary$dif_perc)
cor(All_summary$dif_perc, All_summary$pre_perc, method = "pearson")## [1] -0.5415515plot(All_summary$dif_perc, All_summary$pre_perc)
# SciLit + pres predicted by modelling
m_dif <- lmer(dif_perc ~ model + (1|Sctn_Code:model), data = All_summary)## boundary (singular) fit: see help('isSingular')summary(m_dif)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: dif_perc ~ model + (1 | Sctn_Code:model)
## Data: All_summary
##
## REML criterion at convergence: -291.8
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.5176 -0.4990 0.0499 0.6503 3.6690
##
## Random effects:
## Groups Name Variance Std.Dev.
## Sctn_Code:model (Intercept) 0.00000 0.0000
## Residual 0.01694 0.1301
## Number of obs: 245, groups: Sctn_Code:model, 4
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 0.029221 0.013080 243.000000 2.234 0.0264 *
## modelno -0.006716 0.016944 243.000000 -0.396 0.6922
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## modelno -0.772
## optimizer (nloptwrap) convergence code: 0 (OK)
## boundary (singular) fit: see help('isSingular')# modelno had a negative effect (compared to modelyes) which is what I would expect if modelling had an impact even if small. Not a significant predictor of the difference in scores (t value = 0.396)
m_post <- lmer(post_perc ~ model + (1|Sctn_Code:model), data = All_summary)## boundary (singular) fit: see help('isSingular')m_pre <- lmer(pre_perc ~ model + (1|Sctn_Code:model), data = All_summary)## boundary (singular) fit: see help('isSingular')m_presentation <- lmer(pres_perc ~ model + (1|Sctn_Code:model), data = All_summary)
summary(m_presentation)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: pres_perc ~ model + (1 | Sctn_Code:model)
## Data: All_summary
##
## REML criterion at convergence: -310.9
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -6.9878 -0.3139 0.1808 0.5756 1.2149
##
## Random effects:
## Groups Name Variance Std.Dev.
## Sctn_Code:model (Intercept) 0.001149 0.0339
## Residual 0.015446 0.1243
## Number of obs: 245, groups: Sctn_Code:model, 4
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 0.868268 0.027181 1.995302 31.944 0.000992 ***
## modelno 0.008768 0.037686 1.848671 0.233 0.839220
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## modelno -0.721# paired t test (same students, pre and post) to see if there is a difference between pre and post.
t.test(All_summary$pre_perc, All_summary$post_perc, paired = TRUE, alternative = "two.sided")##
## Paired t-test
##
## data: All_summary$pre_perc and All_summary$post_perc
## t = -3.0383, df = 244, p-value = 0.002638
## alternative hypothesis: true mean difference is not equal to 0
## 95 percent confidence interval:
## -0.041567799 -0.008869519
## sample estimates:
## mean difference
## -0.02521866# t.test to see if model mattered on science literacy and final presentation scores
# p values are identical whether these use score numbers or percentages. This does not include section as a random effect.
stat_dif <- t.test(dif_score~model, data = All_summary)
stat_pre <- t.test(pre_score~model, data = All_summary)
stat_post <- t.test(post_score~model, data = All_summary)
stat_pres <-t.test(FinalPresScores~model, data = All_summary)
# just look at p vals, could make a table with all this later
stat_dif$p.value # no difference is sci lit change depending on treatment## [1] 0.6984321stat_pre$p.value # no difference is sci lit pre score depending on treatment - this was expected b/c no treatment yet## [1] 0.6011486stat_post$p.value # no difference is sci lit post score depending on treatment## [1] 0.8165491stat_pres$p.value # no difference is final presentation score depending on treatment## [1] 0.9796165Plot
Let’s make some plots to illlustrate the impact of the modelling activity of science literacy overall.
need to decide: boxplots on percentages or on scores? score (for difference at least) might be easier to interpret b/c clearly how well they are doing and more or fewer questions answered correctly. So might want to change stats to scores too instead of percentages?
Science and society
Recalculate scores by each of the 9 science literacy skills defined by Gormally et al. (2012). Questions were in different orders pre and post, so this did take some data wrangling.
Step one is to sort the post_all and the pre_all into the same order.
# sort by question number, then random number, then answer
# Random num should be integer
pre_all$Random_Number <- as.integer(pre_all$Random_Number)
pre_all <- arrange(pre_all, `Q..`, `Random_Number`, `Answer`)
# same for post, but also only keep individuals in pre so dataframes same length
post_all <- post_all[post_all$Random_Number %in% pre_all$Random_Number, ]
post_all <- arrange(post_all, `Q..`, `Random_Number`,`Answer`)
# check is rows are the same
pre_all[1000, ]## Attempt.. Attempt.Start Attempt.End Section.. Q.. Q.Type
## 1000 1 2023-02-03 09:41:00 2023-02-03 10:01:00 NA 2 MC
## Q.Title Q.Text Bonus.
## 1000 Which of the following is a valid scientific argument? FALSE
## Difficulty
## 1000 1
## Answer
## 1000 A strain of mice was genetically engineered to lack a certain gene, and the mice were unable to reproduce.\xa0 Introduction of the gene back into the mutant mice restored their ability to reproduce.\xa0 These facts indicate that the gene is essential for mouse reproduction.
## Answer.Match Score Out.Of X19 X20 Random_Number Crse_Code Sctn_Code
## 1000 Checked 1 1 NA NA 526 171 REC4
## Sctn_Id_Code Time
## 1000 223210822 20post_all[1000, ]## Attempt.. Attempt.Start Attempt.End Section.. Q.. Q.Type
## 1000 1 2023-04-27 11:54:00 2023-04-27 12:08:00 NA 2 MC
## Q.Title Q.Text Bonus.
## 1000 Which of the following is a valid scientific argument? FALSE
## Difficulty
## 1000 1
## Answer
## 1000 A strain of mice was genetically engineered to lack a certain gene, and the mice were unable to reproduce.\xa0 Introduction of the gene back into the mutant mice restored their ability to reproduce.\xa0 These facts indicate that the gene is essential for mouse reproduction.
## Answer.Match Score Out.Of X19 X20 Random_Number Crse_Code Sctn_Code
## 1000 Checked 1 1 NA NA 526 171 REC4
## Sctn_Id_Code Time
## 1000 223210822 14pre_all[10006, ]## Attempt.. Attempt.Start Attempt.End Section.. Q.. Q.Type
## 10006 1 2023-02-06 09:54:00 2023-02-06 10:31:00 NA 11 MC
## Q.Title
## 10006
## Q.Text
## 10006 Background for this question: Your interest is piqued by a story about human pheromones on the news. A Google search leads you to the following website: For this website (Eros Foundation), which of the following characteristics is most important in your confidence that the resource is accurate or not.
## Bonus. Difficulty
## 10006 FALSE 1
## Answer
## 10006 The resource may not be accurate, because the purpose of the site is to advertise a product.
## Answer.Match Score Out.Of X19 X20 Random_Number Crse_Code Sctn_Code
## 10006 UnChecked 0 1 NA NA 751 171 REC1
## Sctn_Id_Code Time
## 10006 223210820 37post_all[10006, ]## Attempt.. Attempt.Start Attempt.End Section.. Q.. Q.Type
## 10006 1 2023-04-24 19:35:00 2023-04-24 20:26:00 NA 11 MC
## Q.Title
## 10006
## Q.Text
## 10006 Background for this question: Your interest is piqued by a story about human pheromones on the news. A Google search leads you to the following website: For this website (Eros Foundation), which of the following characteristics is most important in your confidence that the resource is accurate or not.
## Bonus. Difficulty
## 10006 FALSE 1
## Answer
## 10006 The resource may not be accurate, because the purpose of the site is to advertise a product.
## Answer.Match Score Out.Of X19 X20 Random_Number Crse_Code Sctn_Code
## 10006 Checked 1 1 NA NA 751 171 REC1
## Sctn_Id_Code Time
## 10006 223210820 51# add model column to both
pre_all$model <- "no"
pre_all[pre_all$Sctn_Code %in% c("REC2", "REC4"), "model"] <- "yes"
post_all$model <- "no"
post_all[post_all$Sctn_Code %in% c("REC2", "REC4"), "model"] <- "yes"Now that everything is sorted the same, I want to separate into 9 dataframes depending on the question number. but keeping in mind that everything is shifted up one (reference says Q1, is Q2 in this dataframe)
Skill 1 - Identify a valid scientific argument - reference: 1, 8, 11 -> this dataframe: 2, 9, 12 Only writting down this dataframe references for the rest
# keep only the questions I need and only the checked row for each students b/c that will have the score column so I don't need to score by hand.
pre_s1 <- pre_all[pre_all$`Q..` %in% c(2, 9, 12) & pre_all$`Answer.Match` == "Checked", ]
# now group by random number and calculate the score for skill 1
sum_pre_s1 <- pre_s1 %>%
group_by(Random_Number) %>%
summarize(pre_score = sum(Score), Sctn_Code = unique(Sctn_Code), model = unique(model))
# add percentage column
sum_pre_s1$pre_perc <- sum_pre_s1$pre_score / 3
# now for post
post_s1 <- post_all[post_all$`Q..` %in% c(2, 9, 12) & post_all$`Answer.Match` == "Checked", ]
# now group by random number and calculate the score for skill 1
sum_post_s1 <- post_s1 %>%
group_by(Random_Number) %>%
summarize(post_score = sum(Score), Sctn_Code = unique(Sctn_Code), model = unique(model))
# add percentage column
sum_post_s1$post_perc <- sum_post_s1$post_score / 3
# merge those together
sum_s1 <- merge(sum_pre_s1, sum_post_s1, by = c("Random_Number", "Sctn_Code", "model"))
sum_s1$model <- factor(sum_s1$model, levels = c("yes", "no"))
ggplot(sum_s1, aes(x=pre_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s1, aes(x=post_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
# calculate the difference in points
sum_s1$dif_score <- sum_s1$post_score - sum_s1$pre_score
# quick check of what things look like by modelling and section
sum_s1 %>%
group_by(Sctn_Code) %>%
summarize(mean_pre = mean(pre_perc),
mean_post = mean(post_perc),
mean_dif = mean(dif_score))## # A tibble: 4 × 4
## Sctn_Code mean_pre mean_post mean_dif
## <chr> <dbl> <dbl> <dbl>
## 1 REC1 0.831 0.856 0.0769
## 2 REC2 0.780 0.860 0.242
## 3 REC3 0.794 0.852 0.173
## 4 REC4 0.748 0.730 -0.0541# 1 best in pre, 4 worst in post, 4 only one with negative post but basically zero, 2 best increase
ggplot(sum_s1, aes(x=dif_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
# by modelling
sum_s1 %>%
group_by(model) %>%
summarize(mean_pre = mean(pre_perc),
mean_post = mean(post_perc),
mean_dif = mean(dif_score))## # A tibble: 2 × 4
## model mean_pre mean_post mean_dif
## <fct> <dbl> <dbl> <dbl>
## 1 yes 0.768 0.811 0.131
## 2 no 0.811 0.854 0.130# yes had lower pre and post but mean dif is exactly the same
ggplot(sum_s1, aes(x=dif_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ model)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
# do t test to see if difference in scores pre/post matters by modelling
dif_s1 <- t.test(dif_score~model, data = sum_s1)
# add skill column
sum_s1$skill <- 1Skill 2 - Conduct an effective literature search of sources and distinguish between types of sources: 11, 13, 18, 23, 27
# keep only the questions I need and only the checked row for each students b/c that will have the score column so I don't need to score by hand.
pre_s2 <- pre_all[pre_all$`Q..` %in% c(11, 13, 18, 23, 27) & pre_all$`Answer.Match` == "Checked", ]
# now group by random number and calculate the score for skill 2
sum_pre_s2 <- pre_s2 %>%
group_by(Random_Number) %>%
summarize(pre_score = sum(Score), Sctn_Code = unique(Sctn_Code), model = unique(model))
# add percentage column
sum_pre_s2$pre_perc <- sum_pre_s2$pre_score / 5
# now for post
post_s2 <- post_all[post_all$`Q..` %in% c(11, 13, 18, 23, 27) & post_all$`Answer.Match` == "Checked", ]
# now group by random number and calculate the score for skill 2
sum_post_s2 <- post_s2 %>%
group_by(Random_Number) %>%
summarize(post_score = sum(Score), Sctn_Code = unique(Sctn_Code), model = unique(model))
# add percentage column
sum_post_s2$post_perc <- sum_post_s2$post_score / 5
# merge those together
sum_s2 <- merge(sum_pre_s2, sum_post_s2, by = c("Random_Number", "Sctn_Code", "model"))
# calculate the difference in points
sum_s2$dif_score <- sum_s2$post_score - sum_s2$pre_score
# quick check of what things look like by modelling and section
sum_s2 %>%
group_by(Sctn_Code) %>%
summarize(mean_pre = mean(pre_perc),
mean_post = mean(post_perc),
mean_dif = mean(dif_score))## # A tibble: 4 × 4
## Sctn_Code mean_pre mean_post mean_dif
## <chr> <dbl> <dbl> <dbl>
## 1 REC1 0.637 0.658 0.108
## 2 REC2 0.613 0.674 0.306
## 3 REC3 0.654 0.657 0.0123
## 4 REC4 0.654 0.708 0.270# all same pre. 2 and 4 had best increase
# by modelling
sum_s2 %>%
group_by(model) %>%
summarize(mean_pre = mean(pre_perc),
mean_post = mean(post_perc),
mean_dif = mean(dif_score))## # A tibble: 2 × 4
## model mean_pre mean_post mean_dif
## <chr> <dbl> <dbl> <dbl>
## 1 no 0.647 0.658 0.0548
## 2 yes 0.628 0.687 0.293# yes had better increase! but this isnt' something I expected the modelling activity to help with
# do t test to see if difference in scores pre/post matters by modelling
dif_s2 <- t.test(dif_score~model, data = sum_s2)
# add skill column
sum_s2$skill <- 2
sum_s2$model <- factor(sum_s2$model, levels = c("yes", "no"))
ggplot(sum_s2, aes(x=pre_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s2, aes(x=post_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s2, aes(x=dif_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s2, aes(x=dif_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ model)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
Skill 3 - Evaluate the use and misuse of scientific information: 6, 10, 28
# keep only the questions I need and only the checked row for each students b/c that will have the score column so I don't need to score by hand.
pre_s3 <- pre_all[pre_all$`Q..` %in% c(6, 10, 28) & pre_all$`Answer.Match` == "Checked", ]
# now group by random number and calculate the score for skill 3
sum_pre_s3 <- pre_s3 %>%
group_by(Random_Number) %>%
summarize(pre_score = sum(Score), Sctn_Code = unique(Sctn_Code), model = unique(model))
# add percentage column
sum_pre_s3$pre_perc <- sum_pre_s3$pre_score / 3
# now for post
post_s3 <- post_all[post_all$`Q..` %in% c(6, 10, 28) & post_all$`Answer.Match` == "Checked", ]
# now group by random number and calculate the score for skill 3
sum_post_s3 <- post_s3 %>%
group_by(Random_Number) %>%
summarize(post_score = sum(Score), Sctn_Code = unique(Sctn_Code), model = unique(model))
# add percentage column
sum_post_s3$post_perc <- sum_post_s3$post_score / 3
# merge those together
sum_s3 <- merge(sum_pre_s3, sum_post_s3, by = c("Random_Number", "Sctn_Code", "model"))
# calculate the difference in points
sum_s3$dif_score <- sum_s3$post_score - sum_s3$pre_score
# quick check of what things look like by modelling and section
sum_s3 %>%
group_by(Sctn_Code) %>%
summarize(mean_pre = mean(pre_perc),
mean_post = mean(post_perc),
mean_dif = mean(dif_score))## # A tibble: 4 × 4
## Sctn_Code mean_pre mean_post mean_dif
## <chr> <dbl> <dbl> <dbl>
## 1 REC1 0.867 0.903 0.108
## 2 REC2 0.806 0.839 0.0968
## 3 REC3 0.881 0.905 0.0741
## 4 REC4 0.901 0.856 -0.135# 2 lowest pre. 4 highest pre. 4 had big degreast. 1 had big increase
# by modelling
sum_s3 %>%
group_by(model) %>%
summarize(mean_pre = mean(pre_perc),
mean_post = mean(post_perc),
mean_dif = mean(dif_score))## # A tibble: 2 × 4
## model mean_pre mean_post mean_dif
## <chr> <dbl> <dbl> <dbl>
## 1 no 0.874 0.904 0.0890
## 2 yes 0.842 0.845 0.0101# slightly better increase
# do t test to see if difference in scores pre/post matters by modelling
dif_s3 <- t.test(dif_score~model, data = sum_s3)
# add skill column
sum_s3$skill <- 3
#plots
sum_s3$model <- factor(sum_s3$model, levels = c("yes", "no"))
ggplot(sum_s3, aes(x=pre_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s3, aes(x=post_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s3, aes(x=dif_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s3, aes(x=dif_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ model)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
Skill 4 - Understand elements of research design and how they impact scientific findings/conclusions: 5, 14, 15, 26
# keep only the questions I need and only the checked row for each students b/c that will have the score column so I don't need to score by hand.
pre_s4 <- pre_all[pre_all$`Q..` %in% c(5, 14, 15, 26) & pre_all$`Answer.Match` == "Checked", ]
# now group by random number and calculate the score for skill 4
sum_pre_s4 <- pre_s4 %>%
group_by(Random_Number) %>%
summarize(pre_score = sum(Score), Sctn_Code = unique(Sctn_Code), model = unique(model))
# add percentage column
sum_pre_s4$pre_perc <- sum_pre_s4$pre_score / 4
# now for post
post_s4 <- post_all[post_all$`Q..` %in% c(5, 14, 15, 26) & post_all$`Answer.Match` == "Checked", ]
# now group by random number and calculate the score for skill 4
sum_post_s4 <- post_s4 %>%
group_by(Random_Number) %>%
summarize(post_score = sum(Score), Sctn_Code = unique(Sctn_Code), model = unique(model))
# add percentage column
sum_post_s4$post_perc <- sum_post_s4$post_score / 4
# merge those together
sum_s4 <- merge(sum_pre_s4, sum_post_s4, by = c("Random_Number", "Sctn_Code", "model"))
# calculate the difference in points
sum_s4$dif_score <- sum_s4$post_score - sum_s4$pre_score
# quick check of what things look like by modelling and section
sum_s4 %>%
group_by(Sctn_Code) %>%
summarize(mean_pre = mean(pre_perc),
mean_post = mean(post_perc),
mean_dif = mean(dif_score))## # A tibble: 4 × 4
## Sctn_Code mean_pre mean_post mean_dif
## <chr> <dbl> <dbl> <dbl>
## 1 REC1 0.696 0.704 0.0308
## 2 REC2 0.669 0.730 0.242
## 3 REC3 0.651 0.682 0.123
## 4 REC4 0.655 0.703 0.189# 1 highest pre, 2 biggest increase, then 4
# by modelling
sum_s4 %>%
group_by(model) %>%
summarize(mean_pre = mean(pre_perc),
mean_post = mean(post_perc),
mean_dif = mean(dif_score))## # A tibble: 2 × 4
## model mean_pre mean_post mean_dif
## <chr> <dbl> <dbl> <dbl>
## 1 no 0.671 0.692 0.0822
## 2 yes 0.664 0.720 0.222# much bigger increase!
# do t test to see if difference in scores pre/post matters by modelling
dif_s4 <- t.test(dif_score~model, data = sum_s4)
# add skill column
sum_s4$skill <- 4
#plots
sum_s4$model <- factor(sum_s4$model, levels = c("yes", "no"))
ggplot(sum_s4, aes(x=pre_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s4, aes(x=post_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s4, aes(x=dif_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s4, aes(x=dif_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ model)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
Skill 5 - Make a graph: 16
# keep only the questions I need and only the checked row for each students b/c that will have the score column so I don't need to score by hand.
pre_s5 <- pre_all[pre_all$`Q..` %in% c(16) & pre_all$`Answer.Match` == "Checked", ]
# only 1 q so no need to summarize, but only keep some variables. extra columns for binding later.
pre_s5 <- pre_s5[ , c("Random_Number", "Sctn_Code", "model", "Score")]
# rename columns
colnames(pre_s5) <- c("Random_Number", "Sctn_Code", "model", "pre_score")
# add percentage column
pre_s5$pre_perc <- pre_s5$pre_score / 1
# now for post
post_s5 <- post_all[post_all$`Q..` %in% c(16) & post_all$`Answer.Match` == "Checked", ]
post_s5 <- post_s5[ , c("Random_Number", "Sctn_Code", "model", "Score")]
# rename columns
colnames(post_s5) <- c("Random_Number", "Sctn_Code", "model", "post_score")
# add percentage column
post_s5$post_perc <- post_s5$post_score / 1
# merge those together
sum_s5 <- merge(pre_s5, post_s5, by = c("Random_Number", "Sctn_Code", "model"))
# calculate the difference in points
sum_s5$dif_score <- sum_s5$post_score - sum_s5$pre_score
# quick check of what things look like by modelling and section
sum_s5 %>%
group_by(Sctn_Code) %>%
summarize(mean_pre = mean(pre_score),
mean_post = mean(post_score),
mean_dif = mean(dif_score))## # A tibble: 4 × 4
## Sctn_Code mean_pre mean_post mean_dif
## <chr> <dbl> <dbl> <dbl>
## 1 REC1 0.554 0.523 -0.0308
## 2 REC2 0.419 0.532 0.113
## 3 REC3 0.506 0.432 -0.0741
## 4 REC4 0.541 0.405 -0.135# all but section 2 mostly lost this skill.
# by modelling
sum_s5 %>%
group_by(model) %>%
summarize(mean_pre = mean(pre_score),
mean_post = mean(post_score),
mean_dif = mean(dif_score))## # A tibble: 2 × 4
## model mean_pre mean_post mean_dif
## <chr> <dbl> <dbl> <dbl>
## 1 no 0.527 0.473 -0.0548
## 2 yes 0.465 0.485 0.0202# barely increase but is positive while no is barely negative
# do t test to see if difference in scores pre/post matters by modelling
dif_s5 <- t.test(dif_score~model, data = sum_s5)
# add skill column
sum_s5$skill <- 5
#plots
sum_s5$model <- factor(sum_s5$model, levels = c("yes", "no"))
ggplot(sum_s5, aes(x=pre_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s5, aes(x=post_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s5, aes(x=dif_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s5, aes(x=dif_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ model)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
Skill 6 - Read and interpret graphical representations of data: 3, 7, 8, 19
# keep only the questions I need and only the checked row for each students b/c that will have the score column so I don't need to score by hand.
pre_s6 <- pre_all[pre_all$`Q..` %in% c(3, 7, 8, 19) & pre_all$`Answer.Match` == "Checked", ]
# now group by random number and calculate the score for skill 6
sum_pre_s6 <- pre_s6 %>%
group_by(Random_Number) %>%
summarize(pre_score = sum(Score), Sctn_Code = unique(Sctn_Code), model = unique(model))
# add percentage column
sum_pre_s6$pre_perc <- sum_pre_s6$pre_score / 4
# now for post
post_s6 <- post_all[post_all$`Q..` %in% c(3, 7, 8, 19) & post_all$`Answer.Match` == "Checked", ]
# now group by random number and calculate the score for skill 6
sum_post_s6 <- post_s6 %>%
group_by(Random_Number) %>%
summarize(post_score = sum(Score), Sctn_Code = unique(Sctn_Code), model = unique(model))
# add percentage column
sum_post_s6$post_perc <- sum_post_s6$post_score / 4
# merge those together
sum_s6 <- merge(sum_pre_s6, sum_post_s6, by = c("Random_Number", "Sctn_Code", "model"))
# calculate the difference in points
sum_s6$dif_score <- sum_s6$post_score - sum_s6$pre_score
# quick check of what things look like by modelling and section
sum_s6 %>%
group_by(Sctn_Code) %>%
summarize(mean_pre = mean(pre_perc),
mean_post = mean(post_perc),
mean_dif = mean(dif_score))## # A tibble: 4 × 4
## Sctn_Code mean_pre mean_post mean_dif
## <chr> <dbl> <dbl> <dbl>
## 1 REC1 0.765 0.781 0.0615
## 2 REC2 0.746 0.746 0
## 3 REC3 0.775 0.772 -0.0123
## 4 REC4 0.784 0.757 -0.108# 1 small increase, 2 exactly the same, 3 small decrease, 4 big decrease
# by modelling
sum_s6 %>%
group_by(model) %>%
summarize(mean_pre = mean(pre_perc),
mean_post = mean(post_perc),
mean_dif = mean(dif_score))## # A tibble: 2 × 4
## model mean_pre mean_post mean_dif
## <chr> <dbl> <dbl> <dbl>
## 1 no 0.771 0.776 0.0205
## 2 yes 0.760 0.75 -0.0404# decrease but barely while no barely increased
# do t test to see if difference in scores pre/post matters by modelling
dif_s6 <- t.test(dif_score~model, data = sum_s6)
# add skill column
sum_s6$skill <- 6
#plots
sum_s6$model <- factor(sum_s6$model, levels = c("yes", "no"))
ggplot(sum_s6, aes(x=pre_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s6, aes(x=post_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s6, aes(x=dif_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s6, aes(x=dif_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ model)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
Skill 7 - Solve problems using quantitative sklls, including probability and statistics: 17, 21, 24
# keep only the questions I need and only the checked row for each students b/c that will have the score column so I don't need to score by hand.
pre_s7 <- pre_all[pre_all$`Q..` %in% c(17, 21, 24) & pre_all$`Answer.Match` == "Checked", ]
# now group by random number and calculate the score for skill 7
sum_pre_s7 <- pre_s7 %>%
group_by(Random_Number) %>%
summarize(pre_score = sum(Score), Sctn_Code = unique(Sctn_Code), model = unique(model))
# add percentage column
sum_pre_s7$pre_perc <- sum_pre_s7$pre_score / 3
# now for post
post_s7 <- post_all[post_all$`Q..` %in% c(17, 21, 24) & post_all$`Answer.Match` == "Checked", ]
# now group by random number and calculate the score for skill 7
sum_post_s7 <- post_s7 %>%
group_by(Random_Number) %>%
summarize(post_score = sum(Score), Sctn_Code = unique(Sctn_Code), model = unique(model))
# add percentage column
sum_post_s7$post_perc <- sum_post_s7$post_score / 3
# merge those together
sum_s7 <- merge(sum_pre_s7, sum_post_s7, by = c("Random_Number", "Sctn_Code", "model"))
# calculate the difference in points
sum_s7$dif_score <- sum_s7$post_score - sum_s7$pre_score
# quick check of what things look like by modelling and section
sum_s7 %>%
group_by(Sctn_Code) %>%
summarize(mean_pre = mean(pre_perc),
mean_post = mean(post_perc),
mean_dif = mean(dif_score))## # A tibble: 4 × 4
## Sctn_Code mean_pre mean_post mean_dif
## <chr> <dbl> <dbl> <dbl>
## 1 REC1 0.697 0.759 0.185
## 2 REC2 0.661 0.720 0.177
## 3 REC3 0.667 0.695 0.0864
## 4 REC4 0.721 0.757 0.108# 1+2 increased most
# by modelling
sum_s7 %>%
group_by(model) %>%
summarize(mean_pre = mean(pre_perc),
mean_post = mean(post_perc),
mean_dif = mean(dif_score))## # A tibble: 2 × 4
## model mean_pre mean_post mean_dif
## <chr> <dbl> <dbl> <dbl>
## 1 no 0.680 0.724 0.130
## 2 yes 0.684 0.734 0.152# about the same increase
# do t test to see if difference in scores pre/post matters by modelling
dif_s7 <- t.test(dif_score~model, data = sum_s7)
# add skill column
sum_s7$skill <- 7
#plots
sum_s7$model <- factor(sum_s7$model, levels = c("yes", "no"))
ggplot(sum_s7, aes(x=pre_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s7, aes(x=post_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s7, aes(x=dif_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s7, aes(x=dif_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ model)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
Skill 8 - Understand and interpret basic statistics: 4, 20, 25
# keep only the questions I need and only the checked row for each students b/c that will have the score column so I don't need to score by hand.
pre_s8 <- pre_all[pre_all$`Q..` %in% c(4, 20, 25) & pre_all$`Answer.Match` == "Checked", ]
# now group by random number and calculate the score for skill 8
sum_pre_s8 <- pre_s8 %>%
group_by(Random_Number) %>%
summarize(pre_score = sum(Score), Sctn_Code = unique(Sctn_Code), model = unique(model))
# add percentage column
sum_pre_s8$pre_perc <- sum_pre_s8$pre_score / 3
# now for post
post_s8 <- post_all[post_all$`Q..` %in% c(4, 20, 25) & post_all$`Answer.Match` == "Checked", ]
# now group by random number and calculate the score for skill 8
sum_post_s8 <- post_s8 %>%
group_by(Random_Number) %>%
summarize(post_score = sum(Score), Sctn_Code = unique(Sctn_Code), model = unique(model))
# add percentage column
sum_post_s8$post_perc <- sum_post_s8$post_score / 3
# merge those together
sum_s8 <- merge(sum_pre_s8, sum_post_s8, by = c("Random_Number", "Sctn_Code", "model"))
# calculate the difference in points
sum_s8$dif_score <- sum_s8$post_score - sum_s8$pre_score
# quick check of what things look like by modelling and section
sum_s8 %>%
group_by(Sctn_Code) %>%
summarize(mean_pre = mean(pre_perc),
mean_post = mean(post_perc),
mean_dif = mean(dif_score))## # A tibble: 4 × 4
## Sctn_Code mean_pre mean_post mean_dif
## <chr> <dbl> <dbl> <dbl>
## 1 REC1 0.615 0.677 0.185
## 2 REC2 0.602 0.602 0
## 3 REC3 0.617 0.654 0.111
## 4 REC4 0.622 0.658 0.108# 2 stayed exactly the same. rest increased with 1 increasing the most
# by modelling
sum_s8 %>%
group_by(model) %>%
summarize(mean_pre = mean(pre_perc),
mean_post = mean(post_perc),
mean_dif = mean(dif_score))## # A tibble: 2 × 4
## model mean_pre mean_post mean_dif
## <chr> <dbl> <dbl> <dbl>
## 1 no 0.616 0.664 0.144
## 2 yes 0.609 0.623 0.0404# no increased much more than yes
# do t test to see if difference in scores pre/post matters by modelling
dif_s8 <- t.test(dif_score~model, data = sum_s8)
# add skill column
sum_s8$skill <- 8
#plots
sum_s8$model <- factor(sum_s8$model, levels = c("yes", "no"))
ggplot(sum_s8, aes(x=pre_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s8, aes(x=post_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s8, aes(x=dif_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s8, aes(x=dif_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ model)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
Skill 9: Justify inferences, predictions, and conclusions based on quantitative data: 22, 29
# keep only the questions I need and only the checked row for each students b/c that will have the score column so I don't need to score by hand.
pre_s9 <- pre_all[pre_all$`Q..` %in% c(22, 29) & pre_all$`Answer.Match` == "Checked", ]
# now group by random number and calculate the score for skill 9
sum_pre_s9 <- pre_s9 %>%
group_by(Random_Number) %>%
summarize(pre_score = sum(Score), Sctn_Code = unique(Sctn_Code), model = unique(model))
# add percentage column
sum_pre_s9$pre_perc <- sum_pre_s9$pre_score / 2
# now for post
post_s9 <- post_all[post_all$`Q..` %in% c(22, 29) & post_all$`Answer.Match` == "Checked", ]
# now group by random number and calculate the score for skill 9
sum_post_s9 <- post_s9 %>%
group_by(Random_Number) %>%
summarize(post_score = sum(Score), Sctn_Code = unique(Sctn_Code), model = unique(model))
# add percentage column
sum_post_s9$post_perc <- sum_post_s9$post_score / 2
# merge those together
sum_s9 <- merge(sum_pre_s9, sum_post_s9, by = c("Random_Number", "Sctn_Code", "model"))
# calculate the difference in points
sum_s9$dif_score <- sum_s9$post_score - sum_s9$pre_score
# quick check of what things look like by modelling and section
sum_s9 %>%
group_by(Sctn_Code) %>%
summarize(mean_pre = mean(pre_perc),
mean_post = mean(post_perc),
mean_dif = mean(dif_score))## # A tibble: 4 × 4
## Sctn_Code mean_pre mean_post mean_dif
## <chr> <dbl> <dbl> <dbl>
## 1 REC1 0.631 0.685 0.108
## 2 REC2 0.766 0.718 -0.0968
## 3 REC3 0.673 0.660 -0.0247
## 4 REC4 0.676 0.743 0.135# 1+4 decent increase, 2 decent decrase, 3 barely decrease
# by modelling
sum_s9 %>%
group_by(model) %>%
summarize(mean_pre = mean(pre_perc),
mean_post = mean(post_perc),
mean_dif = mean(dif_score))## # A tibble: 2 × 4
## model mean_pre mean_post mean_dif
## <chr> <dbl> <dbl> <dbl>
## 1 no 0.654 0.671 0.0342
## 2 yes 0.732 0.727 -0.0101# no barely increase, yes barely decrease
# do t test to see if difference in scores pre/post matters by modelling
dif_s9 <- t.test(dif_score~model, data = sum_s9)
# add skill column
sum_s9$skill <- 9
#plots
sum_s9$model <- factor(sum_s9$model, levels = c("yes", "no"))
ggplot(sum_s9, aes(x=pre_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s9, aes(x=post_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s9, aes(x=dif_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ Sctn_Code)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
ggplot(sum_s9, aes(x=dif_score ))+
geom_histogram(binwidth=1, aes(color=model, fill = model), alpha = 0.5, position = "identity")+
facet_grid(. ~ model)+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()
Plot!
Let’s make a fancy many facet boxplot :)
Just to see plots
# pre - don't expect a difference
ggplot(data = forplot, aes(x = model, y = pre_perc))+
geom_boxplot(aes(fill = model), color = "black", outlier.color = "black", outlier.shape = 21, outlier.size = 2, notch = FALSE)+
facet_grid(. ~ skill)+
labs(x = "Completed Model for skill", y = "Pre-Science Literacy Score")+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()+
theme(legend.position = "none")
ggplot(data = forplot, aes(x = model, y = post_perc))+
geom_boxplot(aes(fill = model), color = "black", outlier.color = "black", outlier.shape = 21, outlier.size = 2, notch = FALSE)+
facet_grid(. ~ skill)+
labs(x = "Completed Model for skill", y = "Post-Science Literacy Score")+
scale_fill_manual(values = c("#009E73", "#F5C710"))+
scale_color_manual(values = c("#009E73", "#F5C710"))+
theme_classic()+
theme(legend.position = "none")
#print all the p values to see if anything is significant anywhere (I don't think it is)
dif_s1$p.value## [1] 0.9918032dif_s2$p.value # lowest p value! 0.18 would not have guessed from the graph.## [1] 0.1834997dif_s3$p.value## [1] 0.4359397dif_s4$p.value## [1] 0.2979023dif_s5$p.value## [1] 0.3661232dif_s6$p.value## [1] 0.6858128dif_s7$p.value## [1] 0.841479dif_s8$p.value## [1] 0.3834881dif_s9$p.value## [1] 0.7007849Does post science literacy score predict final presentation score?
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: pres_perc ~ post_perc * model + (1 | model:Sctn_Code)
## Data: All_summary
##
## REML criterion at convergence: -305.6
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -6.9691 -0.3126 0.1927 0.5623 1.3551
##
## Random effects:
## Groups Name Variance Std.Dev.
## model:Sctn_Code (Intercept) 0.001143 0.03381
## Residual 0.015507 0.12453
## Number of obs: 245, groups: model:Sctn_Code, 4
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 0.79968 0.07210 76.40340 11.091 <2e-16 ***
## post_perc 0.09468 0.09219 238.84671 1.027 0.305
## modelno 0.07487 0.09300 57.52563 0.805 0.424
## post_perc:modelno -0.09128 0.11705 238.98596 -0.780 0.436
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) pst_pr modeln
## post_perc -0.926
## modelno -0.775 0.718
## pst_prc:mdl 0.730 -0.788 -0.915
##
## Call:
## lm(formula = pres_perc ~ post_perc, data = All_summary)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.87247 -0.04102 0.02878 0.07315 0.13210
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.84625 0.04253 19.90 <2e-16 ***
## post_perc 0.04080 0.05743 0.71 0.478
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.126 on 243 degrees of freedom
## Multiple R-squared: 0.002073, Adjusted R-squared: -0.002034
## F-statistic: 0.5048 on 1 and 243 DF, p-value: 0.4781Need to calculate and use group mean science literacy score so I do not have psuedoreplication within my study.
group_means <- All_summary %>%
group_by(LabTeams) %>% group_by(model, .add = TRUE) %>% group_by(Sctn_Code, .add = TRUE) %>%
summarize(pres_perc = mean(pres_perc), pre_perc = mean(pre_perc), post_perc = mean(post_perc), dif_perc = mean(dif_perc), n = n())## `summarise()` has grouped output by 'LabTeams', 'model'. You can override using
## the `.groups` argument.m2 <- lmer(pres_perc ~ post_perc*model + (1|model:Sctn_Code), data = group_means)
summary(m2)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: pres_perc ~ post_perc * model + (1 | model:Sctn_Code)
## Data: group_means
##
## REML criterion at convergence: -181.4
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -6.6947 -0.4045 0.2165 0.6050 1.6062
##
## Random effects:
## Groups Name Variance Std.Dev.
## model:Sctn_Code (Intercept) 0.001802 0.04245
## Residual 0.014473 0.12030
## Number of obs: 142, groups: model:Sctn_Code, 4
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 0.6861 0.1043 85.9774 6.577 3.58e-09 ***
## post_perc 0.2417 0.1367 135.9857 1.768 0.0793 .
## modelno 0.2440 0.1404 78.3765 1.738 0.0862 .
## post_perc:modelno -0.3174 0.1827 136.1120 -1.737 0.0847 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) pst_pr modeln
## post_perc -0.945
## modelno -0.743 0.702
## pst_prc:mdl 0.707 -0.748 -0.942# model without random effect to simplify plotting. the actual model would have two "model yes' lines and two "model no" lines because 2 sections are in each treatment
m2.2 <- lm(pres_perc ~ post_perc*model, data = group_means)
summary(m2.2)##
## Call:
## lm(formula = pres_perc ~ post_perc * model, data = group_means)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.85122 -0.04386 0.02610 0.07569 0.16955
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.7044 0.1023 6.889 1.82e-10 ***
## post_perc 0.2283 0.1402 1.629 0.106
## modelno 0.2165 0.1369 1.582 0.116
## post_perc:modelno -0.2938 0.1872 -1.570 0.119
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1235 on 138 degrees of freedom
## Multiple R-squared: 0.02113, Adjusted R-squared: -0.0001507
## F-statistic: 0.9929 on 3 and 138 DF, p-value: 0.3982m3 <- lmer(pres_perc ~ dif_perc*model + (1|model:Sctn_Code), data = group_means)
summary(m3)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: pres_perc ~ dif_perc * model + (1 | model:Sctn_Code)
## Data: group_means
##
## REML criterion at convergence: -181.4
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -6.3362 -0.4021 0.2115 0.5881 1.8556
##
## Random effects:
## Groups Name Variance Std.Dev.
## model:Sctn_Code (Intercept) 0.001359 0.03687
## Residual 0.014540 0.12058
## Number of obs: 142, groups: model:Sctn_Code, 4
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 0.85599 0.03084 2.03183 27.756 0.00119 **
## dif_perc 0.21779 0.13459 137.29226 1.618 0.10792
## modelno 0.02083 0.04256 1.84658 0.489 0.67649
## dif_perc:modelno -0.33290 0.19169 136.89787 -1.737 0.08470 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) df_prc modeln
## dif_perc -0.100
## modelno -0.725 0.073
## df_prc:mdln 0.071 -0.702 -0.087# model without random effect to simplify plotting. the actual model would have two "model yes' lines and two "model no" lines because 2 sections are in each treatment
m3.2 <- lm(pres_perc ~ dif_perc*model, data = group_means)
summary(m3.2)##
## Call:
## lm(formula = pres_perc ~ dif_perc * model, data = group_means)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.78945 -0.04404 0.02320 0.07504 0.19964
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.86220 0.01654 52.137 <2e-16 ***
## dif_perc 0.25462 0.13612 1.871 0.0635 .
## modelno 0.01275 0.02139 0.596 0.5519
## dif_perc:modelno -0.35764 0.19430 -1.841 0.0678 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.123 on 138 degrees of freedom
## Multiple R-squared: 0.02884, Adjusted R-squared: 0.007732
## F-statistic: 1.366 on 3 and 138 DF, p-value: 0.2557When predicting final presentation score, the post survey score, the modelling activity, and the interaction are all below p=0.1 with t values at about 1.7.
plot
Plot to see this relationship
## Warning in predict.merMod(m1, newdata = newdata, se.fit = TRUE): unused
## arguments ignored
## [1] 0.5946935
