AS Psychology - Quiz 2 (Research Methods) - Results
Alan Nielsen
September 16, 2021
library(tidyverse) # basic data handling and plotting
library(ggthemes) # used to give additional styling options for graphs
library(plyr) # some data handling commands not included in tidyverse that I find useful
library(kableExtra) # used for creating beautiful and interactive table objects
library(magrittr) # used for additional "pipes" for writing more complex code
library(here) # used for simple file indexing
library(ggrepel) # a graphing utility for scatterplots
library(tippy) # used for embedding tooltips in R Markdown
library(janitor) # for some extra data handling commands
library(ggpubr) # for making grid arrangements of tables with figures
library(gridExtra) # for turning tables into grobs for the above
theme_alan <- function(base_size = 12 , base_family = "")
{
half_line <- base_size/2
colors <- ggthemes_data$few
gray <- colors$medium["gray"]
black <- colors$dark["black"]
theme(
line = element_line(colour = "black", size = 0.5, linetype = 1, lineend = "butt"),
rect = element_rect(fill = "white",
colour = "black", size = 0.5, linetype = 1),
text = element_text(family = base_family, face = "plain", colour = "black",
size = base_size, lineheight = 0.9, hjust = 0.5, vjust = 0.5,
angle = 0, margin = margin(), debug = FALSE),
axis.line = element_blank(),
axis.line.x = NULL,
axis.line.y = NULL,
axis.text = element_text(size = rel(0.8), colour = "grey30"),
axis.text.x = element_text(margin = margin(t = 0.8 * half_line/2), vjust = 1),
axis.text.x.top = element_text(margin = margin(b = 0.8 * half_line/2), vjust = 0),
axis.text.y = element_text(margin = margin(r = 0.8 * half_line/2), hjust = 1),
axis.text.y.right = element_text(margin = margin(l = 0.8 * half_line/2), hjust = 0),
axis.ticks = element_line(colour = "grey20"),
axis.ticks.length = unit(half_line/2, "pt"),
axis.title.x = element_text(margin = margin(t = half_line), vjust = 1),
axis.title.x.top = element_text(margin = margin(b = half_line), vjust = 0),
axis.title.y = element_text(angle = 90, margin = margin(r = half_line), vjust = 1),
axis.title.y.right = element_text(angle = -90, margin = margin(l = half_line), vjust = 0),
legend.background = element_rect(colour = NA),
legend.spacing = unit(0.4, "cm"),
legend.spacing.x = NULL,
legend.spacing.y = NULL,
legend.margin = margin(0.2, 0.2, 0.2, 0.2, "cm"),
legend.key = element_rect(fill = "white", colour = NA),
legend.key.size = unit(1.2, "lines"),
legend.key.height = NULL,
legend.key.width = NULL,
legend.text = element_text(size = rel(0.8)),
legend.text.align = NULL,
legend.title = element_text(hjust = 0),
legend.title.align = NULL,
legend.position = "right",
legend.direction = NULL,
legend.justification = "center",
legend.box = NULL,
legend.box.margin = margin(0, 0, 0, 0, "cm"),
legend.box.background = element_blank(),
legend.box.spacing = unit(0.4, "cm"),
panel.background = element_rect(fill = "white", colour = NA),
panel.border = element_rect(fill = NA, colour = "grey20"),
panel.grid.major = element_line(colour = "grey92"),
panel.grid.minor = element_line(colour = "grey92", size = 0.25),
panel.spacing = unit(half_line, "pt"),
panel.spacing.x = NULL,
panel.spacing.y = NULL,
panel.ontop = FALSE,
strip.background = element_rect(fill = "NA", colour = "NA"),
strip.text = element_text(colour = "grey10", size = rel(0.8)),
strip.text.x = element_text(margin = margin(t = half_line, b = half_line)),
strip.text.y = element_text(angle = 0, margin = margin(l = half_line, r = half_line)),
strip.placement = "inside",
strip.placement.x = NULL,
strip.placement.y = NULL,
strip.switch.pad.grid = unit(0.1, "cm"),
strip.switch.pad.wrap = unit(0.1, "cm"),
plot.background = element_rect(colour = "white"),
plot.title = element_text(size = rel(1.2), hjust = 0, vjust = 1, margin = margin(b = half_line * 1.2)),
plot.subtitle = element_text(size = rel(0.9), hjust = 0, vjust = 1, margin = margin(b = half_line * 0.9)),
plot.caption = element_text(size = rel(0.9), hjust = 1, vjust = 1, margin = margin(t = half_line * 0.9)),
plot.margin = margin(half_line, half_line, half_line, half_line),
complete = TRUE)
}
# Wrapper Function for Long Graph Titles
wrapper <- function(x, ...)
{
paste(strwrap(x, ...), collapse = "\n")
}
#RDFZ Reds
RDFZReds <- c("#cf8f8d", "#ae002b", "#991815", "#78011e", "#4b0315")
#Grade Colors
GradeColors <- c("#8900df", "#0092df", "#00df76", "#94df00", "#BA9900", "#DF7800", "#C85500", "#B23200", "#9b0f00")
#Grade Fill Scale
scale_fill_lettergrades <- function(...){
ggplot2:::manual_scale(
"fill",
values = setNames(GradeColors, c("A*", "A", "B", "C", "D", "E", "F", "G", "U")),
...
)
}
pd <- position_dodge(width = 0.8) #My standard dodging for graphs
#function for allowing inline code chunks to be shown verbatim
rinline <- function(code){
html <- '<code class="r">``` `r CODE` ```</code>'
sub("CODE", code, html)
}#FILL THIS IN WHEN SETTING UP THE SHEET - IT WILL HELP WITH NAMING THE TABLES AND IMAGES THAT ARE OUTPUT, SAVING YOU TIME
Class <- "AS Psychology" #Name of the Class Goes Here
Eval <- "Quiz 2 - Research Methods" #Name of what is being evaluated goes here| Teacher | Average Grade |
|---|---|
| Alan | 69.5 |
| June | 71.1 |
Basics of AS Psychology Quiz 2
The AS Psychology Quiz 2 consisted of 10 questions covering Research Methods, worth a total of 30 points. The questions and their point values can be seen in the table below:
##KNITTED TABLE OF QUESTIONS AND POINT VALUES
QTitle <- paste(Class, Eval, "Questions and Values", sep = " - ")
QT1 <-
Paper1 %>%
head(length(unique(Paper1$Question))) %>%
subset(select = c(Qnum, Question, Value)) %>%
setNames(c("Number", "Question", "Value"))
QuestionsTableP1 <-
QT1 %>%
knitr::kable(caption = QTitle, row.names = F) %>%
row_spec(0, bold = T, color = "white", background = RDFZReds[3])%>%
kable_styling(full_width = FALSE,
bootstrap_options = c("striped", "hover", "condensed"),
fixed_thead = TRUE)
save_kable(QuestionsTableP1, paste(QTitle, ".png", sep = ""))
QuestionsTableP1| Number | Question | Value |
|---|---|---|
| 1a | Dr. Tomato is planning a study to investigate obedience in school children. Her aim is to test whether there is an association between student obedience to the school uniform policy and their grades on CAIE Exams. a)Â Â Â Â Â Describe how Dr. Tomato could conduct a natural experiment to test her aim. [10 marks] | 10 |
| 1b | Draw a graph of the likely results of Dr. Tomato’s study | 3 |
| 2 | Describe the two sides of the nature-nurture debate, using an example for each | 4 |
| 3 | Explain the difference between a participant and a non-participant observer, including an example | 2 |
| 4 | Explain what is meant by “social desirability bias†| 2 |
| 5 | Explain the difference between validity and reliability | 2 |
| 6 | Explain what is meant by “confounding variable†| 2 |
| 7 | Identify one type of confounding variable that can occur in repeated-measures designs but not independent-measures designs | 1 |
| 8 | Explain one research method that can be used to avoid the confounding variable you identified above | 2 |
| 9 | Explain the difference between a bar chart and a histogram | 2 |
Overall Performance
#Single Histogram
OverallTitle <- paste(Class, Eval, "Histogram of Grades", sep = " - ")
ggplot(data=Paper1Totals, aes(x=Grade)) +
geom_histogram(aes(y=..density..), alpha = 1, position = "identity", fill = RDFZReds[2]) +
labs(x="Grade (Percentage)", y="Density") +
stat_function(fun=dnorm, args = list(mean=mean(Paper1Totals$Grade), sd=sd(Paper1Totals$Grade)),
color=RDFZReds[4], size = 1.4) +
scale_x_continuous(limits = c(0,100)) +
theme_alan() +
theme(legend.position = "none") +
ggtitle(wrapper(OverallTitle, width = 45))
ggsave(here(paste(OverallTitle, ".png", sep = "")), plot = last_plot(), device = NULL, path = NULL,
width = 10, height = 6, units = c("in"),
dpi = 600)Overall performance can be seen in the graph above. We had a fairly normal distribution of grades (Shapiro-Wilk Normality test: W= 0.98, p= 0.549) with a mean score of 65.1% (Median = 65%) and a standard deviation of 15.4%.
The high score on the test was 28 out of 30 marks (93.3%), which was achieved by 1 student(s).
The low score on the test was 9 out of 30 marks (30%), which was achieved by 1 student(s).
Letter Grades (Raw)
Typical raw letter grade boundaries for the school can be seen in the table below:
#Note that this already includes rounding up any grade above 0.5 to the next letter grade (e.g. 79.5% = A)
Letters <- c("A*", "A", "B", "C", "D", "E", "U")
MinVal <- c(89.5, 79.5, 69.5, 59.5, 49.5, 39.5, 0)
MaxVal <- c (100, 89.49, 79.49, 69.49, 59.49, 49.49, 39.49)
LetterBoundaries <-
cbind.data.frame(Letters, MinVal, MaxVal) %>%
setNames(c("Letter", "Bottom", "Top"))
LetterGradesTable <-
LetterBoundaries %>%
setNames(c("Letter Grade", "Bottom Boundary", "Top Boundary")) %>%
knitr::kable(caption = "RDFZ Letter Grade Boundaries", row.names = F) %>%
row_spec(0, bold = T, color = "white", background = RDFZReds[3])%>%
kable_styling(full_width = FALSE,
bootstrap_options = c("striped", "hover", "condensed"),
fixed_thead = TRUE) %>%
footnote(general = "Note this includes rounding of grades like 79.5% up a grade boundary" )
LetterGradesTable| Letter Grade | Bottom Boundary | Top Boundary |
|---|---|---|
| A* | 89.5 | 100.00 |
| A | 79.5 | 89.49 |
| B | 69.5 | 79.49 |
| C | 59.5 | 69.49 |
| D | 49.5 | 59.49 |
| E | 39.5 | 49.49 |
| U | 0.0 | 39.49 |
| Note: | ||
| Note this includes rounding of grades like 79.5% up a grade boundary |
If we assign grade boundaries based on these we can see the following distribution of grades
GB1Title <- paste(Class, Eval, "Paper 1", "Letter Grades (Raw)", sep = " - ")
Paper1Totals %<>%
mutate(Letter = cut(x= Paper1Totals$Grade,
breaks = c(LetterBoundaries$Bottom,100),
labels= map_df(LetterBoundaries,rev)$Letter)) %>%
mutate(Letter = factor(Letter, levels =c("U", "E", "D", "C", "B", "A", "A*")))
ggplot(data=Paper1Totals, aes(x=Letter, fill = Letter)) +
geom_bar(stat = "count", position = pd, width = 0.8) +
scale_x_discrete(drop = FALSE) +
scale_fill_lettergrades() +
labs(x="Letter Grade", y="Count") +
theme_alan() +
ggtitle(wrapper(GB1Title, width = 45))
ggsave(here(paste(GB1Title, ".png", sep = "")), plot = last_plot(), device = NULL, path = NULL,
width = 8, height = 6, units = c("in"),
dpi = 600)
LetterCounts <- count(Paper1Totals$Letter)
LetterBoundaries2 <-
LetterBoundaries %>%
mutate(Count = plyr::mapvalues(Letter, from = LetterCounts$x, to = LetterCounts$freq)) %>%
mutate(Count = as.numeric(Count)) %>%
mutate(Count = replace_na(Count, 0))This is actually a pretty good distribution of Grade Boundaries, suggesting that performance on this assessment was at a pretty high level: A total of 10 students earned an A or A-star, with only 6 students earning an E or a U on the exam. The total counts of students in each grade category can be seen in the table below
LetterBoundaries2 %>%
setNames(c("Letter Grade", "Bottom Boundary", "Top Boundary", "Count")) %>%
knitr::kable(caption = "RDFZ Letter Grade Boundaries", row.names = F) %>%
row_spec(0, bold = T, color = "white", background = RDFZReds[3])%>%
kable_styling(full_width = FALSE,
bootstrap_options = c("striped", "hover", "condensed"),
fixed_thead = TRUE) | Letter Grade | Bottom Boundary | Top Boundary | Count |
|---|---|---|---|
| A* | 89.5 | 100.00 | 3 |
| A | 79.5 | 89.49 | 7 |
| B | 69.5 | 79.49 | 10 |
| C | 59.5 | 69.49 | 12 |
| D | 49.5 | 59.49 | 8 |
| E | 39.5 | 49.49 | 4 |
| U | 0.0 | 39.49 | 2 |
Between Class Performance
How do the two classes for AS Psychology compare to one another on Quiz 2 - Research Methods - Paper 1?
Below, you can see a histogram of performance between the two classes.
BetweenTitle <- paste(Class, Eval, "Paper 1", "Histogram of Grades by Class", sep = " - ")
#Histograms by Class
JuneP1Grades <- subset(Paper1Totals, Teacher == "June")
AlanP1Grades <- subset(Paper1Totals, Teacher == "Alan")
ggplot(data=Paper1Totals, aes(x=Grade, fill = Teacher)) +
geom_histogram(aes(y=..density..), alpha = 0.75, position = "identity") +
labs(x="Grade (Percentage)", y="Density") +
stat_function(fun=dnorm, args = list(mean=mean(JuneP1Grades$Grade), sd=sd(JuneP1Grades$Grade)), color=RDFZReds[1], size = 1.2) +
stat_function(fun=dnorm, args = list(mean=mean(AlanP1Grades$Grade), sd=sd(AlanP1Grades$Grade)), color=RDFZReds[4], size = 1.2) +
scale_fill_manual(values= c(RDFZReds[4], RDFZReds[1])) +
scale_x_continuous(limits = c(0,100)) +
theme_alan() +
ggtitle(wrapper(BetweenTitle, width = 45))
ggsave(here(paste(BetweenTitle, ".png", sep = "")), plot = last_plot(), device = NULL, path = NULL,
width = 10, height = 4, units = c("in"),
dpi = 600)
testcompP1 <- t.test(JuneP1Grades$Grade, AlanP1Grades$Grade, warning = FALSE, message = FALSE)We can see that there isn’t much difference at all between the classes. Alan’s AS Psychology class averaged a grade of 64.9% (sd = 14.1%), while June’s class averaged a grade of 65.2% (sd = 16.8%). This difference is not significant: t(42.7) = 0.07, p= 0.95.
Grade Correction
Curving for this test was done by allowing students to complete an assignment of creating Study Cards, for which they were awarded up to 10 Marks, which were applied as a bonus to the percentage score earned on the test. Of the 46 students in the course, a total of 39. The average student who submitted earned a total curve of 6.1794872 percent (Range = 2 to 10).
This change results in the Distribution of Grades seen below:
#Curving and Assigning Letter Boundaries
Paper1Results %<>%
subset(select = c("Teacher", "Student", "Anon", "Raw", "Percentage", "Cards", "Grade", "Practice")) %>%
mutate(Letter = cut(x= Grade,
breaks = c(LetterBoundaries$Bottom,100),
labels= map_df(LetterBoundaries,rev)$Letter)) %>%
mutate(Letter = factor(Letter, levels =c("U", "E", "D", "C", "B", "A", "A*"))) %>%
mutate_if(is.double, round, 1)
#Plotting Distribution of Letter Grades
CurveTitle1 <- paste(Class, Eval, "Distribution of Grades after Curving Quiz 2", sep = " - ")
ggplot(data=Paper1Results, aes(x=Letter, fill = Letter)) +
geom_bar(stat = "count", position = pd, width = 0.8) +
scale_x_discrete(drop = FALSE) +
scale_fill_lettergrades() +
labs(x="Letter Grade", y="Count") +
theme_alan() +
ggtitle(wrapper(CurveTitle1, width = 45))
ggsave(here(paste(CurveTitle1, ".png", sep = "")), plot = last_plot(), device = NULL, path = NULL,
width = 8, height = 6, units = c("in"),
dpi = 600)Not much to say here - a minor curve that pushed the grades up slightly.
Tables
Tables for Engage
# Alan
AlanTitle <- paste(Class, Eval, "Final Grades - Alan", sep = " - ")
AlanTable <-
Paper1Results %>%
subset(Teacher == "Alan") %>%
subset(select = -Teacher) %>%
arrange(-Grade) %>%
knitr::kable(caption = AlanTitle, row.names = F) %>%
row_spec(0, bold = T, color = "white", background = RDFZReds[3])%>%
kable_styling(full_width = FALSE,
bootstrap_options = c("striped", "hover", "condensed"),
fixed_thead = TRUE)
save_kable(AlanTable, paste(AlanTitle, ".png", sep = ""))
# June
JuneTitle <- paste(Class, Eval, "Final Grades - June", sep = " - ")
JuneTable <-
Paper1Results %>%
subset(Teacher == "June") %>%
subset(select = -Teacher) %>%
arrange(Grade) %>%
knitr::kable(caption = JuneTitle, row.names = F) %>%
row_spec(0, bold = T, color = "white", background = RDFZReds[3])%>%
kable_styling(full_width = FALSE,
bootstrap_options = c("striped", "hover", "condensed"),
fixed_thead = TRUE)
save_kable(JuneTable, paste(JuneTitle, ".png", sep = ""))Anonymised Tables
# Alan
AnonTitle <- paste(Class, Eval, "Final Grades - Anonymised", sep = " - ")
AnonTable <-
Paper1Results %>%
subset(select = -c(Student, Teacher)) %>%
arrange(-Grade) %>%
knitr::kable(caption = AnonTitle, row.names = F) %>%
row_spec(0, bold = T, color = "white", background = RDFZReds[3])%>%
kable_styling(full_width = FALSE,
bootstrap_options = c("striped", "hover", "condensed"),
fixed_thead = TRUE)
save_kable(AnonTable, paste(AnonTitle, ".png", sep = ""))
AnonTable| Anon | Raw | Percentage | Cards | Grade | Practice | Letter |
|---|---|---|---|---|---|---|
| J2 | 27 | 90.0 | 10 | 100.0 | 1 | A* |
| J1 | 28 | 93.3 | 6 | 99.3 | 1 | A* |
| A1 | 27 | 90.0 | 7 | 97.0 | 1 | A* |
| A2 | 26 | 86.7 | 6 | 92.7 | 0 | A* |
| J23 | 26 | 86.7 | 6 | 92.7 | 0 | A* |
| A3 | 25 | 83.3 | 7 | 90.3 | 1 | A* |
| A4 | 25 | 83.3 | 7 | 90.3 | 1 | A* |
| J3 | 24 | 80.0 | 8 | 88.0 | 1 | A |
| J4 | 24 | 80.0 | 7 | 87.0 | 0 | A |
| A5 | 23 | 76.7 | 10 | 86.7 | 1 | A |
| J6 | 23 | 76.7 | 7 | 83.7 | 0 | A |
| A9 | 22 | 73.3 | 8 | 81.3 | 1 | A |
| J8 | 22 | 73.3 | 7 | 80.3 | 0 | A |
| J5 | 24 | 80.0 | 0 | 80.0 | 0 | A |
| A21 | 21 | 70.0 | 9 | 79.0 | 0 | B |
| A6 | 22 | 73.3 | 5 | 78.3 | 0 | B |
| J7 | 22 | 73.3 | 5 | 78.3 | 0 | B |
| A7 | 22 | 73.3 | 3 | 76.3 | 1 | B |
| A8 | 22 | 73.3 | 2 | 75.3 | 0 | B |
| A22 | 21 | 70.0 | 5 | 75.0 | 0 | B |
| J9 | 20 | 66.7 | 8 | 74.7 | 0 | B |
| J11 | 20 | 66.7 | 8 | 74.7 | 0 | B |
| J10 | 20 | 66.7 | 7 | 73.7 | 1 | B |
| J12 | 19 | 63.3 | 8 | 71.3 | 0 | B |
| J13 | 19 | 63.3 | 5 | 68.3 | 1 | C |
| A11 | 18 | 60.0 | 8 | 68.0 | 0 | C |
| J15 | 18 | 60.0 | 6 | 66.0 | 0 | C |
| A12 | 18 | 60.0 | 5 | 65.0 | 0 | C |
| J14 | 18 | 60.0 | 5 | 65.0 | 0 | C |
| J16 | 18 | 60.0 | 5 | 65.0 | 0 | C |
| A10 | 19 | 63.3 | 0 | 63.3 | 0 | C |
| A16 | 16 | 53.3 | 7 | 60.3 | 0 | C |
| A13 | 18 | 60.0 | 0 | 60.0 | 0 | C |
| J17 | 16 | 53.3 | 6 | 59.3 | 1 | D |
| A14 | 16 | 53.3 | 5 | 58.3 | 1 | D |
| A18 | 16 | 53.3 | 4 | 57.3 | 0 | D |
| A15 | 16 | 53.3 | 3 | 56.3 | 1 | D |
| J18 | 15 | 50.0 | 6 | 56.0 | 0 | D |
| J19 | 15 | 50.0 | 6 | 56.0 | 1 | D |
| A17 | 16 | 53.3 | 0 | 53.3 | 0 | D |
| J20 | 13 | 43.3 | 6 | 49.3 | 0 | E |
| A19 | 13 | 43.3 | 4 | 47.3 | 0 | E |
| A20 | 13 | 43.3 | 0 | 43.3 | 0 | E |
| A23 | 13 | 43.3 | 0 | 43.3 | 0 | E |
| J21 | 10 | 33.3 | 4 | 37.3 | 0 | U |
| J22 | 9 | 30.0 | 0 | 30.0 | 0 | U |
By-Question Analysis and Comments
In the sections below, we analyse the AS Psychology - Quiz 2 - Research Methods responses on a question by question basis. For each question, we:
* Show the distribution of student grades obtained
* Show the Cambridge Mark Scheme for the question
* Discuss any general comments on student responses, including where students typically went wrong
* Provide two exemplar responses
+ One exemplar response chosen from a student who gave a strong response to the question
+ One exemplar response provided by the Teacher (you should note that this exemplar response will be at a much higher level than you would be expected to provide in either AS or A2 Psychology)
Paper 1
Question 1a-
QNumber <- "1a"
FocalData <-
Paper1 %>%
subset(Qnum == QNumber) %>%
mutate(GradeF = factor(Grade, levels = c(0:Value[1])))
FocalTitle <- paste(Class, Eval, "Paper 1 - ", sep = " - ")
FocalSubTitle <- paste("Question ", QNumber, " - ", FocalData$Question[1], " [", FocalData$Value[1], " marks]", sep = "")
ggplot(data=FocalData, aes(x=GradeF)) +
geom_bar(stat = "count", position = pd, width = 0.8, aes(fill = Teacher)) +
scale_fill_manual(values= c(RDFZReds[4], RDFZReds[1])) +
scale_x_discrete(drop = FALSE) +
labs(x="Question Score", y="Count") +
theme_alan() +
ggtitle(wrapper(FocalTitle, width = 50),
subtitle = wrapper(FocalSubTitle, width = 100))
Cambridge Mark Scheme
Exemplar Response (Teacher)
Aim - Dr. Tomato is interested in looking for a relationship between obedience and school performance Hypothesis- Students who are more obedient (follow the rules for school uniform) will have higher performance on their CAIE exams
Participants and Sampling- A random sample of 60 participants will be drawn from the population of S2 students at RDFZ Chaoyang Branch School. This resulted in 12 Disobedient Participants and 48 Obedient Participants. Participants will be paid with 3 of Dr. Alan’s cookies for their participation in the study.
Ethics- Participants were provided with a cover story that the study was interested in associations between personality characteristics and CAIE grades. They were unaware that the true purpose of the study had to do with obedience to the uniform policy, but after the completion of the study (for which we obtained presumptive consent from another group of students) all participants were full debriefed about the true nature of the study. Data was kept confidential and participants were free to withdraw at any point or to maintain privacy towards any of our filler surveys.
Variables- The “Independent Variable” in this study was whether or not students obeyed uniform policy. Over the course of two months students were brought to the laboratory ten times to fill out brief personality surveys. On each visit the researcher observed whether they were committing any uniform infractions. Participants were labelled as “Disobedient” if they were observed breaking uniform rules on more than one occasion, and otherwise labelled as “Obedient”
The “Dependent Variable” in this study was the student’s average performance (in percentage) on all of their CAIE exams.
Controls- Participants were given filler questionnaires (administered in the same order) to disguise the true nature of the experiment and avoid demand characteristics and social desirability biases. This data (and thus the observation of uniform compliance) was conducted at the same time in the same room for each participant. The Experimenter followed a checklist based on the School’s Uniform policy to determine whether a student’s clothes were in line with policy or not, which increased reliability.
Design- This is an indepedent-measures design
Procedure 1- Participants recruited via random sampling 2- Participants brought to lab and given the fake explanation of the study and give informed consent 3- Every week for 10 weeks participants are brought back to the lab to complete a personality questionnaire 4- On these occasions, the experimenter would observe and score their obedience to the School Uniform Policy 5- Participants collect their CAIE results and self-report them to the experimenter 6- Participants are debriefed about the true purpose of the experiment
Data Analysis- Data was analysed using a two-sample t-test, where the distribution of CAIE scores was compared between students who were obedient and disobedient. The results of this analysis were presented in the form of a bar chart.
Question 1b-
QNumber <- "1b"
FocalData <-
Paper1 %>%
subset(Qnum == QNumber) %>%
mutate(GradeF = factor(Grade, levels = c(0:Value[1])))
FocalTitle <- paste(Class, Eval, "Paper 1 - ", sep = " - ")
FocalSubTitle <- paste("Question ", QNumber, " - ", FocalData$Question[1], " [", FocalData$Value[1], " marks]", sep = "")
ggplot(data=FocalData, aes(x=GradeF)) +
geom_bar(stat = "count", position = pd, width = 0.8, aes(fill = Teacher)) +
scale_fill_manual(values= c(RDFZReds[4], RDFZReds[1])) +
scale_x_discrete(drop = FALSE) +
labs(x="Question Score", y="Count") +
theme_alan() +
ggtitle(wrapper(FocalTitle, width = 50),
subtitle = wrapper(FocalSubTitle, width = 100))
Comments
Overall good work here. We were looking for a Bar Chart ideally, with discrete levels of the IV. We did, however, accept Scatterplots if your variables were operationalised in a way that made a scatterplot appropriate
Remember you need to label your axes, and this needs to include the units
Exemplar Response
Question 2-
QNumber <- "2"
FocalData <-
Paper1 %>%
subset(Qnum == QNumber) %>%
mutate(GradeF = factor(Grade, levels = c(0:Value[1])))
FocalTitle <- paste(Class, Eval, "Paper 1 - ", sep = " - ")
FocalSubTitle <- paste("Question ", QNumber, " - ", FocalData$Question[1], " [", FocalData$Value[1], " marks]", sep = "")
ggplot(data=FocalData, aes(x=GradeF)) +
geom_bar(stat = "count", position = pd, width = 0.8, aes(fill = Teacher)) +
scale_fill_manual(values= c(RDFZReds[4], RDFZReds[1])) +
scale_x_discrete(drop = FALSE) +
labs(x="Question Score", y="Count") +
theme_alan() +
ggtitle(wrapper(FocalTitle, width = 50),
subtitle = wrapper(FocalSubTitle, width = 100))
#### Comments Most people got full marks here. If you didn’t its probably because you didn’t include examples.
Exemplar Response
The nature-nurture debate refers to a debate about whether human behavior is best explained by our natures - the traits that come from our parents via our genes and that we are born with, or via our nurtures - the experiences we have in life and the things we learn. For example we might notice that Ms. June is very smart and wonder why. The nature explanation would suggest that June is smart because her parents were smart, and she inherited their DNA - so she too is smart. The nurture explanation would suggest that June is smart because of her experiences - because she worked hard in school and read many books - that she became smart because of experience.
NB- This example was written by Dr. Alan. June would never write an example about how smart she is
Question 3-
QNumber <- "3"
FocalData <-
Paper1 %>%
subset(Qnum == QNumber) %>%
mutate(GradeF = factor(Grade, levels = c(0:Value[1])))
FocalTitle <- paste(Class, Eval, "Paper 1 - ", sep = " - ")
FocalSubTitle <- paste("Question ", QNumber, " - ", FocalData$Question[1], " [", FocalData$Value[1], " marks]", sep = "")
ggplot(data=FocalData, aes(x=GradeF)) +
geom_bar(stat = "count", position = pd, width = 0.8, aes(fill = Teacher)) +
scale_fill_manual(values= c(RDFZReds[4], RDFZReds[1])) +
scale_x_discrete(drop = FALSE) +
labs(x="Question Score", y="Count") +
theme_alan() +
ggtitle(wrapper(FocalTitle, width = 50),
subtitle = wrapper(FocalSubTitle, width = 100))
#### Comments Some of you are still confusing participant/non-participant with overt/covert.
A participant observer can be either overt or covert, and so can a non-participant observer. I’ve given some examples in the figure below.
Exemplar Response
A participant observer is one who is a natural part of the situation or place that they are observing and who takes part in the activity being observed. For example a teacher can act as a participant observer in their own classroom. On the other hand a non-participant observer does not take part in the event - for example a second teacher might joint a classroom to observe the teacher and student of a class.
Question 4-
QNumber <- "4"
FocalData <-
Paper1 %>%
subset(Qnum == QNumber) %>%
mutate(GradeF = factor(Grade, levels = c(0:Value[1])))
FocalTitle <- paste(Class, Eval, "Paper 1 - ", sep = " - ")
FocalSubTitle <- paste("Question ", QNumber, " - ", FocalData$Question[1], " [", FocalData$Value[1], " marks]", sep = "")
ggplot(data=FocalData, aes(x=GradeF)) +
geom_bar(stat = "count", position = pd, width = 0.8, aes(fill = Teacher)) +
scale_fill_manual(values= c(RDFZReds[4], RDFZReds[1])) +
scale_x_discrete(drop = FALSE) +
labs(x="Question Score", y="Count") +
theme_alan() +
ggtitle(wrapper(FocalTitle, width = 50),
subtitle = wrapper(FocalSubTitle, width = 100))
#### Comments Most of you got full marks here. Good job. Just make sure you don’t confused Social Desirability with Demand Characteristics. Sometimes they overlap but they are not the same thing.
Exemplar Response
Social Desirability Bias refers to the fact that participants will not always give an honest response when asked certain types of sensitive questions - instead they will provide a response that makes them look good or that conforms to social norms. For example a participant might report that they “never lie”, or a homosexual participant might report themselves as being straight because of cultural bias against homosexuals.
Question 5-
QNumber <- "5"
FocalData <-
Paper1 %>%
subset(Qnum == QNumber) %>%
mutate(GradeF = factor(Grade, levels = c(0:Value[1])))
FocalTitle <- paste(Class, Eval, "Paper 1 - ", sep = " - ")
FocalSubTitle <- paste("Question ", QNumber, " - ", FocalData$Question[1], " [", FocalData$Value[1], " marks]", sep = "")
ggplot(data=FocalData, aes(x=GradeF)) +
geom_bar(stat = "count", position = pd, width = 0.8, aes(fill = Teacher)) +
scale_fill_manual(values= c(RDFZReds[4], RDFZReds[1])) +
scale_x_discrete(drop = FALSE) +
labs(x="Question Score", y="Count") +
theme_alan() +
ggtitle(wrapper(FocalTitle, width = 50),
subtitle = wrapper(FocalSubTitle, width = 100))
#### Comments Oof… tough question for ya’ll.
Reliability = whether if we measure the same thing twice we will get the same result Validity = whether we are measuring what we think we are measuring
Exemplar Response
Validity refers to whether or not a measurement is actually measuring what we think it is - or whether the aims of an experiment are met by its operationalisation. So for example when we use an IQ test to measure “Intelligence” we can say that the measurement is valid if IQ actually captures what we all mean by intelligence. Reliability however refers to whether a measure is stable - an IQ test is considered reliable if when we give it to the same person at different times it produces the same results.
Question 6-
QNumber <- "6"
FocalData <-
Paper1 %>%
subset(Qnum == QNumber) %>%
mutate(GradeF = factor(Grade, levels = c(0:Value[1])))
FocalTitle <- paste(Class, Eval, "Paper 1 - ", sep = " - ")
FocalSubTitle <- paste("Question ", QNumber, " - ", FocalData$Question[1], " [", FocalData$Value[1], " marks]", sep = "")
ggplot(data=FocalData, aes(x=GradeF)) +
geom_bar(stat = "count", position = pd, width = 0.8, aes(fill = Teacher)) +
scale_fill_manual(values= c(RDFZReds[4], RDFZReds[1])) +
scale_x_discrete(drop = FALSE) +
labs(x="Question Score", y="Count") +
theme_alan() +
ggtitle(wrapper(FocalTitle, width = 50),
subtitle = wrapper(FocalSubTitle, width = 100))
#### Comments Very few people got full marks here, because very few of you made clear the difference between an Extraneous Variable and a Confounding Variable. A confounding variable is a sub type of extraneous variable that has a specific meaning.
An extraneous variable is anything that might affect performance on the DV that we haven’t controlled. Extraneous variables are largely broken apart into participant variables and confounding variables.
Exemplar Response
A confounding variable is a specific type of extraneous variable that affects peformance on the dependent variable more for participants in one condition of the experiment than others. For example if in a study of attention the participants in one condition completed the test early in the morning they might perform better because they are not tired. If the actual IV here was instead whether participants were given caffeine or not, we would say that caffeine and time-of-day are confounded, which obscures the relationship between the IV and the DV.
Question 7-
QNumber <- "7"
FocalData <-
Paper1 %>%
subset(Qnum == QNumber) %>%
mutate(GradeF = factor(Grade, levels = c(0:Value[1])))
FocalTitle <- paste(Class, Eval, "Paper 1 - ", sep = " - ")
FocalSubTitle <- paste("Question ", QNumber, " - ", FocalData$Question[1], " [", FocalData$Value[1], " marks]", sep = "")
ggplot(data=FocalData, aes(x=GradeF)) +
geom_bar(stat = "count", position = pd, width = 0.8, aes(fill = Teacher)) +
scale_fill_manual(values= c(RDFZReds[4], RDFZReds[1])) +
scale_x_discrete(drop = FALSE) +
labs(x="Question Score", y="Count") +
theme_alan() +
ggtitle(wrapper(FocalTitle, width = 50),
subtitle = wrapper(FocalSubTitle, width = 100))
Comments
Many of you missed the “but not independent measures”. The only type of confound that exists only in repeated-measures designs are “order effects”.
Exemplar Response
Order effects are one type of confounding variable that can be present in Repeated-Measures designs but not independent-measures designs.
Question 8-
QNumber <- "8"
FocalData <-
Paper1 %>%
subset(Qnum == QNumber) %>%
mutate(GradeF = factor(Grade, levels = c(0:Value[1])))
FocalTitle <- paste(Class, Eval, "Paper 1 - ", sep = " - ")
FocalSubTitle <- paste("Question ", QNumber, " - ", FocalData$Question[1], " [", FocalData$Value[1], " marks]", sep = "")
ggplot(data=FocalData, aes(x=GradeF)) +
geom_bar(stat = "count", position = pd, width = 0.8, aes(fill = Teacher)) +
scale_fill_manual(values= c(RDFZReds[4], RDFZReds[1])) +
scale_x_discrete(drop = FALSE) +
labs(x="Question Score", y="Count") +
theme_alan() +
ggtitle(wrapper(FocalTitle, width = 50),
subtitle = wrapper(FocalSubTitle, width = 100))
Comments
Most of you got no marks here because you didn’t identify the correct type of confound on the previous question.
Exemplar Response
Order effects like the fatigue effect can be avoided by making use of counterbalancing, which ensures that participants are split into different groups who experience the conditions of the experiment in different orders. In a classic “ABBA” design half of the participants take part in Condition A and then Condition B, while the other half take part in B then A. This allows us to see whether the order of completion has an effect on DV performance and thus determine the relationship between the IV and DV.
Question 9-
QNumber <- "9"
FocalData <-
Paper1 %>%
subset(Qnum == QNumber) %>%
mutate(GradeF = factor(Grade, levels = c(0:Value[1])))
FocalTitle <- paste(Class, Eval, "Paper 1 - ", sep = " - ")
FocalSubTitle <- paste("Question ", QNumber, " - ", FocalData$Question[1], " [", FocalData$Value[1], " marks]", sep = "")
ggplot(data=FocalData, aes(x=GradeF)) +
geom_bar(stat = "count", position = pd, width = 0.8, aes(fill = Teacher)) +
scale_fill_manual(values= c(RDFZReds[4], RDFZReds[1])) +
scale_x_discrete(drop = FALSE) +
labs(x="Question Score", y="Count") +
theme_alan() +
ggtitle(wrapper(FocalTitle, width = 50),
subtitle = wrapper(FocalSubTitle, width = 100))
#### Comments Performance was okay here, but you were asked to Explain, so make sure you do that
Exemplar Response
The main difference between a bar chart and a histogram is the type of data that they show. A histogram is used to show the distribution of continuous data, with the Y axis being the frequency of each level of observation of the numeric variable displayed on the X axis. For example the graph above is a histogram. A bar chart on the other hand is used for comparing discrete categories (shown on the x axis), and typically the mean value of the DV is shown on the Y axis.
Correlations between study cards and overall performance
FocalTitle <- "Correlation of Quiz 1 Performance and Study Card Bonus - Overall"
Corr1 <- cor.test(as.numeric(as.character(Paper1Results$Percentage)), as.numeric(as.character(Paper1Results$Cards)))
Corr1StatA <- "Pearson's product moment correlation:"
Corr1StatB <- paste("r = ", round(Corr1$estimate,2), sep = "")
Corr1StatC <- paste("(t", Corr1$parameter, " = " , round(Corr1$statistic, 1), ", p = ",
ifelse(Corr1$p.value>0.001, round(Corr1$p.value,3), "<0.001"), ")" , sep = "")
#Plot
ggplot(data=Paper1Results, aes(x=as.numeric(as.character(Percentage)), y = as.numeric(as.character(Cards)))) +
geom_jitter(color = RDFZReds[2], size = 1) +
geom_smooth(method = "lm", se = FALSE, size = 1.2, color = RDFZReds[4]) +
geom_label_repel(aes(label = Anon)) +
scale_x_continuous(breaks = c(0,25,50,75,100), limits= c(0,100) ) +
scale_y_continuous(breaks = 0:10, limits= c(2,10) ) +
labs(x="Uncurved Exam Grade (Percentage)", y="Study Cards Bonus (out of 10)") +
annotate("text", x= 80, y = 4, label = wrapper(Corr1StatA, width = 20), hjust = 0, vjust = 0, fontface = "bold" ) +
annotate("text", x= 80, y = 3.5, label = wrapper(Corr1StatB, width = 30), hjust = 0, vjust= 0, fontface = "italic" ) +
annotate("text", x= 80, y = 3, label = wrapper(Corr1StatC, width = 30), hjust = 0, vjust = 0) +
theme_alan() +
ggtitle(wrapper(FocalTitle, width = 60))
The observed correlation between performance on the Quiz and Study Card grades is of moderate strength and is statistically significant. How might you explain this association?
Correlations between study cards and overall performance
FocalTitle <- "Correlation of Quiz 1 Performance and Practice Quiz Submission - Overall"
Corr1 <- cor.test(as.numeric(as.character(Paper1Results$Percentage)), as.numeric(as.character(Paper1Results$Practice)))
Corr1StatA <- "Pearson's product moment correlation:"
Corr1StatB <- paste("r = ", round(Corr1$estimate,2), sep = "")
Corr1StatC <- paste("(t", Corr1$parameter, " = " , round(Corr1$statistic, 1), ", p = ",
ifelse(Corr1$p.value>0.001, round(Corr1$p.value,3), "<0.001"), ")" , sep = "")
#Plot
ggplot(data=Paper1Results, aes(x=as.numeric(as.character(Percentage)), y = as.numeric(as.character(Practice)))) +
geom_jitter(color = RDFZReds[2], size = 1) +
geom_smooth(method = "lm", se = FALSE, size = 1.2, color = RDFZReds[4]) +
geom_label_repel(aes(label = Anon)) +
scale_x_continuous(breaks = c(0,25,50,75,100), limits= c(0,100) ) +
scale_y_continuous(breaks = 0:1, limits= c(0,1) ) +
labs(x="Uncurved Exam Grade (Percentage)", y="Study Cards Bonus (out of 10)") +
annotate("text", x= 5, y = .8, label = wrapper(Corr1StatA, width = 20), hjust = 0, vjust = 0, fontface = "bold" ) +
annotate("text", x= 5, y = .7, label = wrapper(Corr1StatB, width = 30), hjust = 0, vjust= 0, fontface = "italic" ) +
annotate("text", x= 5, y = .6, label = wrapper(Corr1StatC, width = 30), hjust = 0, vjust = 0) +
theme_alan() +
ggtitle(wrapper(FocalTitle, width = 60))
The correlation here looks weaker, but because this is a binary correlation its actually fairly strong - generally participants who completed and submitted the practice quiz performed better on the test. How might you explain this association?
If you have any questions or comments about student performance in the class, please don’t hesitate to get in touch via email to Alan Nielsen or June Zhu.
This report was generated using R Markdown.
Comments
Responses were generally okay here, but were lacking STRUCTURE and missing some of the components
Remember that you need:
Aim:
Hypothesis:
Participants and Sampling:
Ethics:
Variables (including operationalisation):
Controls:
Design:
Procedure:
Data Analysis:
There were two things missing primarily from the Mark Scheme
1) Variables were rarely well operationalised - an operationalisation needs to include how a scores was calculated and what the units are - if you don’t have those things you haven’t provided an operationalisation
2) Language - a proper response needs to use the correct technical language throughtout - random sampling, random allocations, etc.
A few of you lost additional marks for either not answering the right question, or providing an experimental design that didn’t meet the criteria. I.E. This explicitly asked for a NATURAL EXPERIMENT, which means there is no allocation of subjects into levels of the IV - instead you’re looking at naturally occurring variation in the IV.
For this reason things like a matched pairs design also weren’t appropriate - you cannot match kids on their grades and then test their grades - you’re just ensuring that you’ll find no effect.