Assumes libraries tidyverse, descriptr, gridExtra
df_raw = read_excel("S2_Pre_Post_full.xlsx")
Rescaling needed: * P1Q1 max 6, Q2 max 4, Q3 max 3, Q4 max 2, total max 15 * P2Q1 max 4, Q2 max 4, Q3 max 3, Q4 max 2, total max 13 * TRANSFER1 and 2 max 10 each.
Instead of the absolute scores we need the percentage in terms of the maximum score. We can use a scale from 0 to 10 with integer values.
df <- df_raw
df$ROLE <- factor(df$ROLE, levels = c(1,9), labels = c("tutor_first", "tutee_first"))
df$Pair <- factor(df$Pair)
# Pretest Scatterplot
df$P1Q1 <-as.integer(round(df$P1Q1/6.0 * 10, digits = 0))
df$P1Q2 <-as.integer(round(df$P1Q2/4.0 * 10, digits = 0))
df$P1Q3 <-as.integer(round(df$P1Q3/3.0 * 10, digits = 0))
df$P1Q4 <-as.integer(round(df$P1Q4/2.0 * 10, digits = 0))
# Pretest BWD
df$P2Q1 <-as.integer(round(df$P2Q1/4.0 * 10, digits = 0))
df$P2Q2 <-as.integer(round(df$P2Q2/4.0 * 10, digits = 0))
df$P2Q3 <-as.integer(round(df$P2Q3/3.0 * 10, digits = 0))
df$P2Q4 <-as.integer(round(df$P2Q4/2.0 * 10, digits = 0))
# Post-test Scatterplot
df$POSTP1Q1 <-as.integer(round(df$POSTP1Q1/6.0 * 10, digits = 0))
df$POSTP1Q2 <-as.integer(round(df$POSTP1Q2/4.0 * 10, digits = 0))
df$POSTP1Q3 <-as.integer(round(df$POSTP1Q3/3.0 * 10, digits = 0))
df$POSTP1Q4 <-as.integer(round(df$POSTP1Q4/2.0 * 10, digits = 0))
# Post-test BWD
df$POSTP2Q1 <-as.integer(round(df$POSTP2Q1/4.0 * 10, digits = 0))
df$POSTP2Q2 <-as.integer(round(df$POSTP2Q2/4.0 * 10, digits = 0))
df$POSTP2Q3 <-as.integer(round(df$POSTP2Q3/3.0 * 10, digits = 0))
df$POSTP2Q4 <-as.integer(round(df$POSTP2Q4/2.0 * 10, digits = 0))
# Transfer items to integers
df$TRANSFER1 <- as.integer(df$TRANSFER1)
df$TRANSFER2 <- as.integer(df$TRANSFER2)
Now we need to re-compute the marginal scores. Let’s first drop the old columns:
df <- select(df, -c("PRE-SCORE", "POST-SCORE"))
And now compute the new marginal scores:
# average scores:
There were 23 warnings (use warnings() to see them)
df <- mutate (df, PREAVG = PRESCORE/8)
I think we are ready now for the analysis.
The principe maximal score in the test is 80.
ds_summary_stats(df,PRESCORE)
────────────────────────────────────────────── Variable: PRESCORE ──────────────────────────────────────────────
Univariate Analysis
N 46.00 Variance 394.23
Missing 0.00 Std Deviation 19.86
Mean 38.89 Range 75.00
Median 37.50 Interquartile Range 27.25
Mode 13.00 Uncorrected SS 87317.00
Trimmed Mean 38.50 Corrected SS 17740.46
Skewness 0.35 Coeff Variation 51.05
Kurtosis -0.78 Std Error Mean 2.93
Quantiles
Quantile Value
Max 80.00
99% 79.10
95% 72.00
90% 68.00
Q3 51.75
Median 37.50
Q1 24.50
10% 14.50
5% 12.25
1% 6.80
Min 5.00
Extreme Values
Low High
Obs Value Obs Value
38 5 37 80
25 9 35 78
32 12 8 73
21 13 4 69
26 13 16 69
ggplot(df, aes(PRESCORE)) +
geom_histogram(bins = 10)
ggplot(df, aes(x = 1, y = PRESCORE)) +
geom_boxplot() +
scale_x_continuous(breaks = NULL) +
theme(axis.title.x = element_blank())
To interpret changes due to ROLE later, is there a differnce in the pre-test between students that subseqently were in the tutor_first or tutee_first role?
ggplot(df, aes(x = ROLE, y = PRESCORE)) +
geom_boxplot() +
xlab("Tutor role")
While the tutor_first is slightly better, this is likely random. A t-test agrees, with p greater than 0.05.
t.test(df$PRESCORE ~df$ROLE)
Welch Two Sample t-test
data: df$PRESCORE by df$ROLE
t = 0.52296, df = 43.403, p-value = 0.6037
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
-8.814075 14.987988
sample estimates:
mean in group tutor_first mean in group tutee_first
40.43478 37.34783
The non-parametric Wilcoxon test further confirms that there is no significant difference between the two groups:
wilcox.test(df$PRESCORE ~df$ROLE)
cannot compute exact p-value with ties
Wilcoxon rank sum test with continuity correction
data: df$PRESCORE by df$ROLE
W = 288, p-value = 0.6133
alternative hypothesis: true location shift is not equal to 0
ds_summary_stats(df,POSTSCORE)
─────────────────────────────────────────────── Variable: POSTSCORE ───────────────────────────────────────────────
Univariate Analysis
N 46.00 Variance 384.17
Missing 0.00 Std Deviation 19.60
Mean 52.30 Range 68.00
Median 58.50 Interquartile Range 31.00
Mode 26.00 Uncorrected SS 143132.00
Trimmed Mean 52.86 Corrected SS 17287.74
Skewness -0.55 Coeff Variation 37.47
Kurtosis -0.91 Std Error Mean 2.89
Quantiles
Quantile Value
Max 80.00
99% 79.10
95% 77.25
90% 74.50
Q3 68.00
Median 58.50
Q1 37.00
10% 23.00
5% 19.00
1% 13.80
Min 12.00
Extreme Values
Low High
Obs Value Obs Value
19 12 35 80
6 16 37 78
13 19 39 78
32 19 9 75
38 21 24 75
# ggplot(df, aes(POSTSCORE)) + geom_bar()
ggplot(df, aes(POSTSCORE)) +
geom_histogram(bins = 10)
Check:we’d like to know if the cases with the low values are the same from pre to post test. That would indicate non-engagment.
ggplot(df, aes(x = 1, y = POSTSCORE)) +
geom_boxplot() +
scale_x_continuous(breaks = NULL) +
theme(axis.title.x = element_blank())
By role:
ggplot(df, aes(x = ROLE, y = POSTSCORE)) +
geom_boxplot() +
xlab("Tutor role")
The difference between the two conditions is marginal, by inspection, also keeping in mind that the pre-test scores where sliglyt elavated for the tutor_first condition. A test reveals no significant difference.
t.test(df$POSTSCORE ~df$ROLE)
Welch Two Sample t-test
data: df$POSTSCORE by df$ROLE
t = 0.53732, df = 43.954, p-value = 0.5938
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
-8.611533 14.872402
sample estimates:
mean in group tutor_first mean in group tutee_first
53.86957 50.73913
In the further analysis we treat the two groups as comparable.
The intervention was clearly effective:
t.test(df$POSTSCORE, df$PRESCORE, paired=T)
Paired t-test
data: df$POSTSCORE and df$PRESCORE
t = 5.7233, df = 45, p-value = 8.025e-07
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
8.692841 18.133246
sample estimates:
mean of the differences
13.41304
Looking at the individual gain scores, we see that hile most of the gain scores are positive, with negative values being few and small values only, the loss score of 33 points for student in position 8 (S2-AM-9) is rather extreme.
df$gain <- df$POSTSCORE - df$PRESCORE
df$gain
[1] 16 10 12 0 10 -1 20 -33 21 13 43 23 -3 29 7 -10 27 -11 -7 10 12 1 41 8 17 33 16
[28] 26 37 26 17 7 32 20 2 -5 -2 16 28 40 2 -2 21 20 32 -4
This can be explained by this student not actually engaging with the post-test….
ds_summary_stats(df, gain)
──────────────────────────────────────────────── Variable: gain ────────────────────────────────────────────────
Univariate Analysis
N 46.00 Variance 252.65
Missing 0.00 Std Deviation 15.89
Mean 13.41 Range 76.00
Median 14.50 Interquartile Range 24.00
Mode 10.00 Uncorrected SS 19645.00
Trimmed Mean 13.74 Corrected SS 11369.15
Skewness -0.32 Coeff Variation 118.50
Kurtosis 0.27 Std Error Mean 2.34
Quantiles
Quantile Value
Max 43.00
99% 42.10
95% 39.25
90% 32.50
Q3 25.25
Median 14.50
Q1 1.25
10% -4.50
5% -9.25
1% -23.10
Min -33.00
Extreme Values
Low High
Obs Value Obs Value
8 -33 11 43
18 -11 23 41
16 -10 40 40
19 -7 29 37
36 -5 26 33
Strong learning gains:
t.test(df$POSTAVG, df$PREAVG, paired=T)
Paired t-test
data: df$POSTAVG and df$PREAVG
t = 5.7233, df = 45, p-value = 8.025e-07
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
1.086605 2.266656
sample estimates:
mean of the differences
1.67663
df$gain_avg <- df$POSTAVG - df$PREAVG
df$gain_avg
[1] 2.000 1.250 1.500 0.000 1.250 -0.125 2.500 -4.125 2.625 1.625 5.375 2.875 -0.375 3.625 0.875
[16] -1.250 3.375 -1.375 -0.875 1.250 1.500 0.125 5.125 1.000 2.125 4.125 2.000 3.250 4.625 3.250
[31] 2.125 0.875 4.000 2.500 0.250 -0.625 -0.250 2.000 3.500 5.000 0.250 -0.250 2.625 2.500 4.000
[46] -0.500
ds_summary_stats(df,gain_avg)
────────────────────────────────────────────── Variable: gain_avg ──────────────────────────────────────────────
Univariate Analysis
N 46.00 Variance 3.95
Missing 0.00 Std Deviation 1.99
Mean 1.68 Range 9.50
Median 1.81 Interquartile Range 3.00
Mode 1.25 Uncorrected SS 306.95
Trimmed Mean 1.72 Corrected SS 177.64
Skewness -0.32 Coeff Variation 118.50
Kurtosis 0.27 Std Error Mean 0.29
Quantiles
Quantile Value
Max 5.38
99% 5.26
95% 4.91
90% 4.06
Q3 3.16
Median 1.81
Q1 0.16
10% -0.56
5% -1.16
1% -2.89
Min -4.12
Extreme Values
Low High
Obs Value Obs Value
8 -4.125 11 5.375
18 -1.375 23 5.125
16 -1.25 40 5
19 -0.875 29 4.625
36 -0.625 26 4.125
Given that the students had no very little initial knowledge, losses in the post test need to be explained on a case by case basis. We do this in three sections:
No gain or loss likely means non-engagement. This pattern holds for these cases:
S2-AM-9:
Others?
The principe maximal score in the test is 80.
ds_summary_stats(df,PREAVG)
───────────────────────────────────────────── Variable: PREAVG ────────────────────────────────────────────
Univariate Analysis
N 46.00 Variance 6.16
Missing 0.00 Std Deviation 2.48
Mean 4.86 Range 9.38
Median 4.69 Interquartile Range 3.41
Mode 1.62 Uncorrected SS 1364.33
Trimmed Mean 4.81 Corrected SS 277.19
Skewness 0.35 Coeff Variation 51.05
Kurtosis -0.78 Std Error Mean 0.37
Quantiles
Quantile Value
Max 10.00
99% 9.89
95% 9.00
90% 8.50
Q3 6.47
Median 4.69
Q1 3.06
10% 1.81
5% 1.53
1% 0.85
Min 0.62
Extreme Values
Low High
Obs Value Obs Value
38 0.625 37 10
25 1.125 35 9.75
32 1.5 8 9.125
21 1.625 4 8.625
26 1.625 16 8.625
There were 26 warnings (use warnings() to see them)
ggplot(df, aes(PREAVG)) +
geom_histogram(bins = 10)
ggplot(df, aes(x = 1, y = PREAVG)) +
geom_boxplot() +
scale_x_continuous(breaks = NULL) +
theme(axis.title.x = element_blank())
To interpret changes due to ROLE later, is there a differnce in the pre-test between students that subseqently were in the tutor_first or tutee_first role?
ggplot(df, aes(x = ROLE, y = PREAVG)) +
geom_boxplot() +
xlab("Tutor role")
While the tutor_first is slightly better, this is likely random. A t-test agrees, with p greater than 0.05.
t.test(df$PREAVG ~df$ROLE)
Welch Two Sample t-test
data: df$PREAVG by df$ROLE
t = 0.52296, df = 43.403, p-value = 0.6037
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
-1.101759 1.873498
sample estimates:
mean in group tutor_first mean in group tutee_first
5.054348 4.668478
The non-parametric Wilcoxon test further confirms that there is no significant difference between the two groups:
wilcox.test(df$PREAVG ~df$ROLE)
cannot compute exact p-value with ties
Wilcoxon rank sum test with continuity correction
data: df$PREAVG by df$ROLE
W = 288, p-value = 0.6133
alternative hypothesis: true location shift is not equal to 0
The principe maximal score in the test is 80.
ds_summary_stats(df,POSTAVG)
─────────────────────────────── Variable: POSTAVG ──────────────────────────────
Univariate Analysis
N 46.00 Variance 6.00
Missing 0.00 Std Deviation 2.45
Mean 6.54 Range 8.50
Median 7.31 Interquartile Range 3.88
Mode 3.25 Uncorrected SS 2236.44
Trimmed Mean 6.61 Corrected SS 270.12
Skewness -0.55 Coeff Variation 37.47
Kurtosis -0.91 Std Error Mean 0.36
Quantiles
Quantile Value
Max 10.00
99% 9.89
95% 9.66
90% 9.31
Q3 8.50
Median 7.31
Q1 4.62
10% 2.88
5% 2.38
1% 1.73
Min 1.50
Extreme Values
Low High
Obs Value Obs Value
19 1.5 35 10
6 2 37 9.75
13 2.375 39 9.75
32 2.375 9 9.375
38 2.625 24 9.375
There were 23 warnings (use warnings() to see them)
ggplot(df, aes(POSTAVG)) +
geom_histogram(bins = 10)
ggplot(df, aes(x = 1, y = POSTAVG)) +
geom_boxplot() +
scale_x_continuous(breaks = NULL) +
theme(axis.title.x = element_blank())
is there a differnce between students that subseqently were in the tutor_first or tutee_first role?
ggplot(df, aes(x = ROLE, y = POSTAVG)) +
geom_boxplot() +
xlab("Tutor role")
While the tutor_first is slightly better, this is likely random. A t-test agrees, with p greater than 0.05.
t.test(df$POSTAVG ~df$ROLE)
Welch Two Sample t-test
data: df$POSTAVG by df$ROLE
t = 0.53732, df = 43.954, p-value = 0.5938
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
-1.076442 1.859050
sample estimates:
mean in group tutor_first mean in group tutee_first
6.733696 6.342391
The non-parametric Wilcoxon test further confirms that there is no significant difference between the two groups:
wilcox.test(df$POSTAVG ~df$ROLE)
cannot compute exact p-value with ties
Wilcoxon rank sum test with continuity correction
data: df$POSTAVG by df$ROLE
W = 289, p-value = 0.5978
alternative hypothesis: true location shift is not equal to 0
df$P1Q1
[1] 2 3 8 10 2 3 3 3 7 3 3 8 3 5 10 10 8 7 5 3 3 7 0 10 3 3 10 8 3 2 5 2 5 5 8 0 10
[38] 3 8 3 2 7 7 3 2 5
df$POSTP1Q1
[1] 3 3 10 10 0 2 3 0 10 5 3 8 0 8 10 10 10 8 5 3 3 10 7 10 3 10 8 3 10 10 7 5 10 7 10 3 8
[38] 3 8 10 0 10 10 8 7 2
ds_summary_stats(df,P1Q1, POSTP1Q1 )
────────────────────────────────────────────────── Variable: P1Q1 ─────────────────────────────────────────────────
Univariate Analysis
N 46.00 Variance 8.62
Missing 0.00 Std Deviation 2.94
Mean 5.00 Range 10.00
Median 4.00 Interquartile Range 4.75
Mode 3.00 Uncorrected SS 1538.00
Trimmed Mean 5.00 Corrected SS 388.00
Skewness 0.39 Coeff Variation 58.73
Kurtosis -1.06 Std Error Mean 0.43
Quantiles
Quantile Value
Max 10.00
99% 10.00
95% 10.00
90% 10.00
Q3 7.75
Median 4.00
Q1 3.00
10% 2.00
5% 2.00
1% 0.00
Min 0.00
Extreme Values
Low High
Obs Value Obs Value
23 0 4 10
36 0 15 10
1 2 16 10
5 2 24 10
30 2 27 10
──────────────────────────────────────────────── Variable: POSTP1Q1 ───────────────────────────────────────────────
Univariate Analysis
N 46.00 Variance 12.24
Missing 0.00 Std Deviation 3.50
Mean 6.37 Range 10.00
Median 7.50 Interquartile Range 7.00
Mode 10.00 Uncorrected SS 2417.00
Trimmed Mean 6.50 Corrected SS 550.72
Skewness -0.43 Coeff Variation 54.92
Kurtosis -1.27 Std Error Mean 0.52
Quantiles
Quantile Value
Max 10.00
99% 10.00
95% 10.00
90% 10.00
Q3 10.00
Median 7.50
Q1 3.00
10% 2.00
5% 0.00
1% 0.00
Min 0.00
Extreme Values
Low High
Obs Value Obs Value
5 0 3 10
8 0 4 10
13 0 9 10
41 0 15 10
6 2 16 10
boxplot(df$P1Q1, data = df)
boxplot(df$POSTP1Q1, data = df)
ggplot(df, aes(P1Q1)) + geom_bar()
ggplot(df, aes(POSTP1Q1)) + geom_bar()
df$P1Q2
df$POSTP1Q2
ds_summary_stats(df,P1Q2, POSTP1Q2)
ggplot(df, aes(P1Q2)) + geom_bar()
ggplot(df, aes(POSTP1Q2)) + geom_bar()
The prestest has a very odd distribution: Check!
df$P1Q3
df$POSTP1Q3
ds_summary_stats(df,P1Q3, POSTP1Q3 )
boxplot(df$P1Q3, data = df)
boxplot(df$POSTP1Q3, data = df)
ggplot(df, aes(P1Q3)) + geom_bar()
ggplot(df, aes(POSTP1Q3)) + geom_bar()
df$P1Q4
df$POSTP1Q4
ds_summary_stats(df,P1Q4, POSTP1Q4 )
boxplot(df$P1Q4, data = df)
boxplot(df$POSTP1Q4, data = df)
ggplot(df, aes(P1Q4)) + geom_bar()
ggplot(df, aes(POSTP1Q4)) + geom_bar()
df$P2Q1
df$POSTP2Q1
ds_summary_stats(df,P2Q1, POSTP2Q1 )
boxplot(df$P2Q1, data = df)
boxplot(df$POSTP2Q1, data = df)
ggplot(df, aes(P2Q1)) + geom_bar()
ggplot(df, aes(POSTP2Q1)) + geom_bar()
df$P2Q2
df$POSTP2Q2
ds_summary_stats(df,P2Q2, POSTP2Q2 )
boxplot(df$P2Q2, data = df)
boxplot(df$POSTP2Q2, data = df)
ggplot(df, aes(P2Q2)) + geom_bar()
ggplot(df, aes(POSTP2Q2)) + geom_bar()
df$P2Q3
df$POSTP2Q3
ds_summary_stats(df,P2Q3, POSTP2Q3 )
boxplot(df$P2Q3, data = df)
boxplot(df$POSTP2Q3, data = df)
ggplot(df, aes(P2Q3)) + geom_bar()
ggplot(df, aes(POSTP2Q3)) + geom_bar()
df$P2Q4
df$POSTP2Q4
ds_summary_stats(df,P2Q4, POSTP2Q4 )
boxplot(df$P2Q4, data = df)
boxplot(df$POSTP2Q4, data = df)
ggplot(df, aes(P2Q4)) + geom_bar()
ggplot(df, aes(POSTP2Q4)) + geom_bar()
df$TRANSFER1
[1] 5 10 10 8 0 7 9 0 7 5 7 7 3 5 9 6 5 3 0 6 0 0 5 9 4 0 5 6 8 9 9 0 8 7 10 5 7
[38] 2 10 8 5 2 8 5 0 0
ds_summary_stats(df,TRANSFER1 )
─────────────────────────────────────────────── Variable: TRANSFER1 ───────────────────────────────────────────────
Univariate Analysis
N 46.00 Variance 11.11
Missing 0.00 Std Deviation 3.33
Mean 5.30 Range 10.00
Median 5.50 Interquartile Range 5.00
Mode 0.00 Uncorrected SS 1794.00
Trimmed Mean 5.33 Corrected SS 499.74
Skewness -0.41 Coeff Variation 62.83
Kurtosis -1.03 Std Error Mean 0.49
Quantiles
Quantile Value
Max 10.00
99% 10.00
95% 10.00
90% 9.00
Q3 8.00
Median 5.50
Q1 3.00
10% 0.00
5% 0.00
1% 0.00
Min 0.00
Extreme Values
Low High
Obs Value Obs Value
5 0 2 10
8 0 3 10
19 0 35 10
21 0 39 10
22 0 7 9
boxplot(df$TRANSFER1, data = df)
ggplot(df, aes(TRANSFER1)) + geom_histogram(bins = 6)
ggplot(df, aes(x = ROLE, y = TRANSFER1)) +
geom_boxplot() +
xlab("Tutor role")
Visually yes and also statistically significant:
t.test(df$TRANSFER1 ~df$ROLE)
Welch Two Sample t-test
data: df$TRANSFER1 by df$ROLE
t = 2.112, df = 43.782, p-value = 0.04042
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
0.09127597 3.90872403
sample estimates:
mean in group tutor_first mean in group tutee_first
6.304348 4.304348
df$TRANSFER2
[1] 0 9 0 9 0 6 10 0 8 9 10 10 0 0 10 8 8 3 0 9 0 0 9 10 4 3 8 9 10 10 9 0 9 8 10 8 8
[38] 0 10 9 0 2 9 6 0 0
ds_summary_stats(df,TRANSFER2 )
─────────────────────────────────────────────── Variable: TRANSFER2 ───────────────────────────────────────────────
Univariate Analysis
N 46.00 Variance 17.74
Missing 0.00 Std Deviation 4.21
Mean 5.65 Range 10.00
Median 8.00 Interquartile Range 9.00
Mode 0.00 Uncorrected SS 2268.00
Trimmed Mean 5.71 Corrected SS 798.43
Skewness -0.44 Coeff Variation 74.52
Kurtosis -1.66 Std Error Mean 0.62
Quantiles
Quantile Value
Max 10.00
99% 10.00
95% 10.00
90% 10.00
Q3 9.00
Median 8.00
Q1 0.00
10% 0.00
5% 0.00
1% 0.00
Min 0.00
Extreme Values
Low High
Obs Value Obs Value
1 0 7 10
3 0 11 10
5 0 12 10
8 0 15 10
13 0 24 10
boxplot(df$TRANSFER2, data = df)
ggplot(df, aes(TRANSFER2)) + geom_histogram(bins = 6)
This might indicate that in the post test we have two groups of students: Those who pretty much got it and those who pretty much not.
ggplot(df, aes(x = ROLE, y = TRANSFER2)) +
geom_boxplot() +
xlab("Tutor role")
Visually yes but missing statistical significance because of the large variation in the scores:
t.test(df$TRANSFER2 ~df$ROLE)
Welch Two Sample t-test
data: df$TRANSFER2 by df$ROLE
t = 1.5647, df = 43.993, p-value = 0.1248
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
-0.5509621 4.3770490
sample estimates:
mean in group tutor_first mean in group tutee_first
6.608696 4.695652
For the qualitative analysis it would be worth finding out what can be said about the two ‘extreme’ groups. This item would also be the one as a basis for extrem group comparisons, splitting on the median.
df$TRANSFER <- df$TRANSFER1 + df$TRANSFER2
ds_summary_stats(df,TRANSFER )
───────────────────────────────────────── Variable: TRANSFER ────────────────────────────────────────
Univariate Analysis
N 46.00 Variance 50.84
Missing 0.00 Std Deviation 7.13
Mean 10.96 Range 20.00
Median 13.50 Interquartile Range 12.75
Mode 0.00 Uncorrected SS 7810.00
Trimmed Mean 11.05 Corrected SS 2287.91
Skewness -0.44 Coeff Variation 65.08
Kurtosis -1.39 Std Error Mean 1.05
Quantiles
Quantile Value
Max 20.00
99% 20.00
95% 19.00
90% 19.00
Q3 17.00
Median 13.50
Q1 4.25
10% 0.00
5% 0.00
1% 0.00
Min 0.00
Extreme Values
Low High
Obs Value Obs Value
5 0 35 20
8 0 39 20
19 0 2 19
21 0 7 19
22 0 15 19
boxplot(df$TRANSFER, data = df)
ggplot(df, aes(TRANSFER)) + geom_histogram(bins = 8)
ggplot(df, aes(x = ROLE, y = TRANSFER)) +
geom_boxplot() +
xlab("Tutor role")
t.test(df$TRANSFER ~df$ROLE)
Welch Two Sample t-test
data: df$TRANSFER by df$ROLE
t = 1.9154, df = 43.668, p-value = 0.062
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
-0.2050992 8.0311861
sample estimates:
mean in group tutor_first mean in group tutee_first
12.91304 9.00000
Dalal, this is for cases where you may want to make extrem group comparisons later. But you picked a subset anyway. So just for completenes:
So, a median split could be on a score 8.0 of TRANSFER2, the BWD item. It would yield the following 20 students for low score (Less than 8):
low_scorers <- filter(df, TRANSFER2 < 8.0)
low_scorers <- as_vector(low_scorers$Stdcode)
low_scorers
[1] "S2_AM_1" "S2_AM_3" "S2_AM_5" "S2_AM_6" "S2_AM_9" "S2_AM_14" "S2_AM_01" "S2_AM_05"
[9] "S2_AM_06" "S2_AM_08" "S2_AM_010" "S2_AM_013" "S2_AM_014" "S2_PM_6" "S2_PM_02" "S2_PM_05"
[17] "S2_PM_06" "S2_PM_08" "S2_PM_09" "S2_PM_010"
And these 26 for scores GEQ 8.0:
high_scorers <- filter(df, TRANSFER2 >= 8.0)
high_scorers <- as_vector(high_scorers$Stdcode)
high_scorers
[1] "S2_AM_2" "S2_AM_4" "S2_AM_7" "S2_AM_10" "S2_AM_11" "S2_AM_12" "S2_AM_13" "S2_AM_02"
[9] "S2_AM_03" "S2_AM_04" "S2_AM_07" "S2_AM_011" "S2_AM_012" "S2_PM_1" "S2_PM_2" "S2_PM_3"
[17] "S2_PM_4" "S2_PM_5" "S2_PM_7" "S2_PM_8" "S2_PM_9" "S2_PM_10" "S2_PM_01" "S2_PM_03"
[25] "S2_PM_04" "S2_PM_07"
Filtering out six likely cases of non-engagement:
df <- filter(df, Stdcode != "S2_AM_9", Stdcode != "S2_AM_6", Stdcode != "S2_AM_06",
Stdcode != "S2_AM_14", Stdcode != "S2_PM_010", Stdcode != "S2_PM_05")
Treatment effect general :
t.test(df$POST.SCORE, df$PRE.SCORE, paired=T)
Strong as ever.
Significant differences regarding role before intervention?
t.test(df$PRE.SCORE ~df$ROLE)
No.
After intervention?
t.test(df$POST.SCORE ~df$ROLE)
ALso not.
How about Transfer item Scatterplat?
t.test(df$TRANSFER1 ~df$ROLE)
Not quite but close.
And BWD Transfer?
t.test(df$TRANSFER2 ~df$ROLE)
More clearly not.
So, removing the non-engaged students doesn’t help with the significance testing. Suggestion is to not do analysis with these removed because it raises issues with selection criteria. Keep discussion to qualitative to have explanation for no learning/loss cases.
Reset df in case the selection of non engaged was peformed:
df = read.csv("S2_Pre_Post_full.csv", header = T)
df$ROLE <- factor(df$ROLE, levels = c(1,9), labels = c("tutor_first", "tutee_first"))
Let’s concentrate on the posttest items because we assume more or less zero knowledge in pre-test.
postdf <- df %>% select(starts_with("POST"))
Note: We use the Stdcode and the factors here was well. Perhaps this can be done more elegantly?
Look at the correlations of the post-test items. rcorr()
is from the package Hmisc
.
rcorr(as.matrix(postdf))
POSTP1Q1 POSTP1Q2 POSTP1Q3 POSTP1Q4 POSTP2Q1 POSTP2Q2 POSTP2Q3 POSTP2Q4 POSTSCORE
POSTP1Q1 1.00 0.57 0.22 0.27 0.56 0.37 0.29 0.11 0.63
POSTP1Q2 0.57 1.00 0.32 0.67 0.60 0.69 0.30 0.36 0.87
POSTP1Q3 0.22 0.32 1.00 0.28 0.24 0.33 0.39 -0.06 0.43
POSTP1Q4 0.27 0.67 0.28 1.00 0.50 0.45 0.15 0.20 0.68
POSTP2Q1 0.56 0.60 0.24 0.50 1.00 0.61 0.19 0.26 0.76
POSTP2Q2 0.37 0.69 0.33 0.45 0.61 1.00 0.40 0.43 0.83
POSTP2Q3 0.29 0.30 0.39 0.15 0.19 0.40 1.00 0.47 0.55
POSTP2Q4 0.11 0.36 -0.06 0.20 0.26 0.43 0.47 1.00 0.55
POSTSCORE 0.63 0.87 0.43 0.68 0.76 0.83 0.55 0.55 1.00
n= 46
P
POSTP1Q1 POSTP1Q2 POSTP1Q3 POSTP1Q4 POSTP2Q1 POSTP2Q2 POSTP2Q3 POSTP2Q4 POSTSCORE
POSTP1Q1 0.0000 0.1410 0.0689 0.0000 0.0103 0.0537 0.4467 0.0000
POSTP1Q2 0.0000 0.0320 0.0000 0.0000 0.0000 0.0458 0.0148 0.0000
POSTP1Q3 0.1410 0.0320 0.0559 0.1115 0.0243 0.0069 0.6966 0.0031
POSTP1Q4 0.0689 0.0000 0.0559 0.0004 0.0016 0.3325 0.1737 0.0000
POSTP2Q1 0.0000 0.0000 0.1115 0.0004 0.0000 0.2183 0.0844 0.0000
POSTP2Q2 0.0103 0.0000 0.0243 0.0016 0.0000 0.0057 0.0026 0.0000
POSTP2Q3 0.0537 0.0458 0.0069 0.3325 0.2183 0.0057 0.0011 0.0000
POSTP2Q4 0.4467 0.0148 0.6966 0.1737 0.0844 0.0026 0.0011 0.0000
POSTSCORE 0.0000 0.0000 0.0031 0.0000 0.0000 0.0000 0.0000 0.0000
Any P LEQ0.05 can be considered significant.
We can think of a students’ scores in the post-test as a kind of profile, and ask if there are clusters of students with similar profiles. This is what a cluster analysis lets us find out.
We may have to think about what the post-test values mean and if a standardisation is required. We might need to standardise if the maximal scores are different between items.
Using Euclidian distance, we compute the distance between the students:
dist.eucl <- dist(postdf, method = "euclidean")
The first 10 students’ distances are:
round(as.matrix(dist.eucl)[1:10, 1:10], 1)
The smaller the value, the more similar the students’ score profile.
Lets’ find clusters and visualise them.
posthc <- hclust(d = dist.eucl, method = "ward.D2")
# cex: label size
fviz_dend(posthc, cex = 0.5)
Dalal, the students are the row numbers in the excel table minus 1 for variable names.
and can you see a patern at the level where we have tree clusters?
You read the dendrogram from bottom to top, see here
Need to have a look at the differences in the clustering results once I understand the implications of standardisation more. If the items have differnt maximal scores, the standardisation is necessary in any case. But we already rescaled items on 1-10 values, so I think at this stage that scalilng in the CA sense is not needed.
postdf_std <- scale(postdf)
head(postdf_std, nrow=6)
POSTP1Q1 POSTP1Q2 POSTP1Q3 POSTP1Q4 POSTP2Q1 POSTP2Q2 POSTP2Q3 POSTP2Q4
[1,] -0.9631983 0.6488973 -0.08071886 0.6175402 -0.05361556 -1.195598 0.2464416 -0.5387811
[2,] -0.9631983 0.6488973 -0.08071886 0.6175402 -0.05361556 1.058399 1.2770158 0.7004155
[3,] 1.0377685 0.6488973 -0.08071886 0.6175402 1.31655988 1.058399 0.2464416 0.7004155
[4,] 1.0377685 0.6488973 -0.08071886 0.6175402 -0.05361556 1.058399 0.2464416 0.7004155
[5,] -1.8207556 -1.7778731 -2.20247167 0.6175402 -1.42379100 -1.195598 -1.1276572 0.7004155
[6,] -1.2490508 -1.7778731 -0.08071886 -1.8526207 -1.42379100 -1.195598 0.2464416 -1.7779778
POSTSCORE
[1,] -0.2706258
[2,] 0.6477273
[3,] 1.1069038
[4,] 0.8518057
[5,] -1.3420376
[6,] -1.8522338
dist.eucl <- dist(postdf_std, method = "euclidean")
posthc <- hclust(d = dist.eucl, method = "ward.D2")
fviz_dend(posthc, cex = 0.5)
df_coded = read_excel("coding-counts.xlsx")
df_coded$Study <- factor(df_coded$Study)
df_codes <- select(df_coded, -c("Stdcode", "Study"))
There are lots of zeros, so this by and large may not be a good idea.
# rcorr(as.matrix(df_codes))
We can think of a students’ scores in the post-test as a kind of profile, and ask if there are clusters of students with similar profiles. This is what a cluster analysis lets us find out.
We may have to think about what the post-test values mean and if a standardisation is required. We might need to standardise if the maximal scores are different between items.
Using Euclidian distance, we compute the distance between the students:
dist.eucl <- dist(df_codes, method = "euclidean")
The first 10 students’ distances are:
round(as.matrix(dist.eucl)[1:10, 1:10], 1)
1 2 3 4 5 6 7 8 9 10
1 0.0 13.0 13.6 24.9 13.4 22.7 11.1 19.4 12.4 13.6
2 13.0 0.0 13.5 20.6 13.4 20.3 15.0 15.8 15.6 9.4
3 13.6 13.5 0.0 26.5 17.3 26.5 16.9 23.5 19.8 12.9
4 24.9 20.6 26.5 0.0 19.1 8.4 21.0 8.3 17.7 17.7
5 13.4 13.4 17.3 19.1 0.0 17.3 8.6 15.4 13.3 13.2
6 22.7 20.3 26.5 8.4 17.3 0.0 17.5 7.9 15.9 17.6
7 11.1 15.0 16.9 21.0 8.6 17.5 0.0 15.9 11.0 13.7
8 19.4 15.8 23.5 8.3 15.4 7.9 15.9 0.0 12.6 14.0
9 12.4 15.6 19.8 17.7 13.3 15.9 11.0 12.6 0.0 14.5
10 13.6 9.4 12.9 17.7 13.2 17.6 13.7 14.0 14.5 0.0
The smaller the value, the more similar the students’ score profile.
Lets’ find clusters and visualise them.
posthc <- hclust(d = dist.eucl, method = "ward.D2")
# cex: label size
fviz_dend(posthc, cex = 0.5)
postdf_std <- scale(df_codes)
dist.eucl <- dist(postdf_std, method = "euclidean")
posthc <- hclust(d = dist.eucl, method = "ward.D2")
fviz_dend(posthc, cex = 0.5)