-
Notifications
You must be signed in to change notification settings - Fork 3
/
Copy pathtgroupsdf.pl
198 lines (172 loc) · 7.99 KB
/
tgroupsdf.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
:- module(tgroupsdf, []).
:- use_module(library(http/html_write)).
:- use_module(session).
:- use_module(r_session).
:- use_module(library(mcclass)).
:- use_module(mathml).
:- discontiguous intermediate/1, expert/4, buggy/4, feedback/4, hint/4, r_hook/1.
% Prettier symbols for mathematical rendering
math_hook(n_vr, subscript(n, "VR")).
math_hook(n_box, subscript(n, "Box")).
math_hook(vr, overline("VR")).
math_hook(s_vr, subscript(s, "VR")).
math_hook(box, overline("Box")).
math_hook(s_box, subscript(s, "Box")).
math_hook(n, subscript('N', "total")).
% Obtain information from R
r_hook(n_vr).
r_hook(n_box).
r_hook(vr).
r_hook(s_vr).
r_hook(box).
r_hook(s_box).
r_hook(n).
r_hook(df).
r_hook('<-'/2).
render(item(VR, S_VR, N_VR, Box, S_Box, N_Box), Form) -->
{ option(resp(R), Form, '##.##') },
html(
[ div(class(card), div(class('card-body'),
[ h1(class('card-title'), "Training of surgical skills"),
p(class('card-text'),
[ "Surgeons need special motor skills, especially for ",
"endoscopic surgery through the belly. Nickel et al. (2015) ",
"report the results of a study with two learning methods for ",
"motor skill training. One group underwent a virtual reality ",
"training (VR group), the other group participated in a ",
"mixture of online courses and classical training of motor ",
"skill with the so-called Box-trainer (Box group). ",
"The primary dependent variable is the result on the OSATS ",
"test (interval scaled, normally distributed, high scores = ",
"good performance). A few more dependent variables were ",
"assessed, including a knowledge test (interval scaled), ",
"operation time (dichotomized, above or below 80 min), and ",
"efficiency ratings (ordinal scale, 1=bad ... 5=good)."
]),
p(class('card-text'),
[ "Please check the following text from the publication ",
"(40 ± 10 means “average 40, standard deviation 10”):"
]),
p(class('card-text'),
[ "“Laparoscopy-naïve medical students were randomized into ",
"two groups. The Box group (",
\mmlm(N_Box = r(N_Box)), ") used E-learning for ",
"laparoscopic cholecystectomy and practiced ",
"basic skills with Box trainers. The VR group (",
\mmlm(N_VR = r(N_VR)), ") trained ",
"basic skills and laparoscopic cholecystectomy on ",
"LAP Mentor II (Simbionix, Cleveland, USA). Each group ",
"trained 3 × 4 hours followed by a knowledge test. Blinded ",
"raters assessed the operative performance using the ",
"Objective Structured Assessment of Technical Skills ",
"(OSATS). The VR group completed the operation significantly ",
"faster and more often within 80 min than the Box ",
"group (VR: 28% vs. Box: 22%, p = 0.596). The Box group ",
"scored higher than the VR group in the knowledge ",
"test (Box: 13.4 ± 1.2 vs. VR: 10.8 ± 1.8, p < 0.001). Both ",
"groups showed equal operative performance in the OSATS score ",
"(VR: ", \mmlm([digits(1)], r(VR)), " ± ", \mmlm([digits(1)], r(S_VR)),
" vs. BOX: ", \mmlm([digits(1)], r(Box)), " ± ", \mmlm([digits(1)], r(S_Box)),
", p = 0.437). The significance level is set to ",
\mmlm(alpha = [5, "%"]), " two-tailed. ",
"Students generally liked training and felt well prepared for ",
"assisting in laparoscopic surgery. The efficiency of the training ",
"was judged higher by the VR group than by the Box group."
])
])),
div(class(card), div(class('card-body'),
[ h4(class('card-title'), [a(id(question), []), "Question"]),
p(class('card-text'),
[ "How many degrees of freedom do you have to account for?"
]),
form([class(form), method('POST'), action('#tgroupsdf-indep')],
[ div(class("input-group mb-3"),
[ div(class("input-group-prepend"),
span(class("input-group-text"), "Response")),
input([class("form-control"), type(text), name(resp), value(R)]),
div(class("input-group-append"),
button([class('btn btn-primary'), type(submit)], "Submit"))
])])
]))
]).
% t-test for independent groups
intermediate(item).
start(item(vr, s_vr, n_vr, box, s_box, n_box)).
% Correctly identified the problem as a t-test for independent groups.
expert(stage(2), From, To, [step(expert, indep, [])]) :-
From = item(_VR, _S_VR, N_VR, _BOX, _S_BOX, N_BOX),
To = { '<-'(df, N_VR + N_BOX - 2) ;
df
}.
feedback(indep, [], _Col, FB) =>
FB = [ "You correctly calculated the degrees of freedom." ].
hint(indep, [], _Col, FB) =>
FB = [ "Try to do everthing correctly." ].
% 1) subtracted 1 rather than 2
buggy(stage(2), From, To, [step(buggy, one, [])]) :-
From = N_VR + N_BOX - 2,
To = N_VR + N_BOX - color(one, 1).
feedback(one, [], Col, FB) =>
FB = [ "Please remember to subtract ", \mmlm(Col, 1),
\mmlm(Col, color(one, " per")), " sample." ].
hint(one, [], Col, FB) =>
FB = [ "Subtract ", \mmlm(Col, color(one, 2)), " instead of ",
\mmlm(Col, color(one, 1)) ].
% 2) used only the sample size of N_VR.
buggy(stage(2), From, To, [step(buggy, singlen, [N_VR, N_BOX])]) :-
From = N_VR + N_BOX - 2,
To = omit_right(singlen, N_VR + N_BOX) - 2.
buggy(stage(2), From, To, [step(buggy, singlen2, [N_VR, N_BOX])]) :-
From = N_VR + N_BOX - 2,
To = omit_left(singlen2, N_VR + N_BOX) - 2.
feedback(singlen, [N_VR, N_BOX], Col, FB) =>
FB = [ "Please remember to add up ", \mmlm(Col, color(singlen, N_VR + N_BOX)) ].
feedback(singlen2, [N_VR, N_BOX], Col, FB) =>
FB = [ "Please remember to add up ", \mmlm(Col, color(singlen2, N_VR + N_BOX)) ].
hint(singlen, [N_VR, N_BOX], Col, FB) =>
FB = [ "Do not forget to add up ", \mmlm(Col, color(singlen, N_VR + N_BOX)) ].
hint(singlen2, [N_VR, N_BOX], Col, FB) =>
FB = [ "Do not forget to add up ", \mmlm(Col, color(singlen2, N_VR + N_BOX)) ].
% 3) and again, but with -1.
buggy(stage(2), From, To, [step(buggy, singlen3, [N_VR, N_BOX])]) :-
From = N_VR + N_BOX - 2,
To = omit_left(singlen3, N_VR + N_BOX) - color(singlen3, 1).
buggy(stage(2), From, To, [step(buggy, singlen4, [N_VR, N_BOX])]) :-
From = N_VR + N_BOX - 2,
To = omit_right(singlen4, N_VR + N_BOX) - color(singlen4, 1).
feedback(singlen3, [N_VR, N_BOX], Col, FB) =>
FB = [ "Please remember to add up ",
\mmlm(Col, color(singlen3, N_VR + N_BOX)), " and to subtract ",
\mmlm(Col, 1), \mmlm(Col, color(singlen3, " per")), " sample."].
feedback(singlen4, [N_VR, N_BOX], Col, FB) =>
FB = [ "Please remember to add up ",
\mmlm(Col, color(singlen4, N_VR + N_BOX)), " and to subtract ",
\mmlm(Col, 1), \mmlm(Col, color(singlen4, " per")), " sample."].
hint(singlen3, [N_VR, N_BOX], Col, FB) =>
FB = [ "Do not forget to add up ",
\mmlm(Col, color(singlen3, N_VR + N_BOX)), " and to subtract ",
\mmlm(Col, 1), \mmlm(Col, color(singlen3, " per")), " sample." ].
hint(singlen4, [N_VR, N_BOX], Col, FB) =>
FB = [ "Do not forget to add up ",
\mmlm(Col, color(singlen4, N_VR + N_BOX)), " and to subtract ",
\mmlm(Col, 1), \mmlm(Col, color(singlen4, " per")), " sample." ].
% 4) Gguessed that there is one degree of freedom per group.
buggy(stage(2), From, To, [step(buggy, guess, [From])]) :-
From = N_VR + N_BOX - 2,
To = instead(guess, 2.00, N_VR + N_BOX - 2).
feedback(guess, [_From], Col, FB) =>
FB = [ "While the ", \mmlm(Col, "df"), " depend on the number of groups ",
" they are more than just the number of groups." ].
hint(guess, [From], Col, FB) =>
FB = [ "The correct formula for ", \mmlm(Col, "df"), " is ",
\mmlm(Col, color(guess, From)) ].
% 5) Forgot to subtract 2.
buggy(stage(2), From, To, [step(buggy, nosub, [N_VR, N_BOX])]) :-
From = N_VR + N_BOX - 2,
To = omit_right(nosub, (N_VR + N_BOX) - 2).
feedback(nosub, [_N_VR, _N_BOX], Col, FB) =>
FB = [ "Please remember to subtract ", \mmlm(Col, color(nosub, 2)),
" from the sum of test subjects ." ].
hint(nosub, [N_VR, N_BOX], Col, FB) =>
FB = [ "Do not forget to subtract ", \mmlm(Col, color(nosub, 2)),
" from ", \mmlm(Col, N_VR + N_BOX) ].