scoring.pm

DENIS S├ębastien, 12/06/2018 05:12 pm

Download (36.1 kB)

 
1
# -*- perl -*-
2
#
3
# Copyright (C) 2011-2016 Alexis Bienvenue <paamc@passoire.fr>
4
#
5
# This file is part of Auto-Multiple-Choice
6
#
7
# Auto-Multiple-Choice is free software: you can redistribute it
8
# and/or modify it under the terms of the GNU General Public License
9
# as published by the Free Software Foundation, either version 2 of
10
# the License, or (at your option) any later version.
11
#
12
# Auto-Multiple-Choice is distributed in the hope that it will be
13
# useful, but WITHOUT ANY WARRANTY; without even the implied warranty
14
# of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
15
# General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Auto-Multiple-Choice.  If not, see
19
# <http://www.gnu.org/licenses/>.
20
21
package AMC::DataModule::scoring;
22
23
# AMC scoring management.
24
25
# This module is used to store (in a SQLite database) and handle all
26
# data concerning data scoring (scoring strategies, scores and marks).
27
28
# TERMINOLOGY NOTE:
29
#
30
# 'student' refers to the student number that is written at the top of
31
# each page, in the format +<student>/<page>/<check>+
32
#
33
# If the questions are printed from AMC, and not photocopied, each
34
# physical student has a different student number on his sheet.
35
#
36
# If some questions are photocopied before beeing distributed to the
37
# students, several students can have the same student number. To make
38
# a difference between their completed answer sheets, a 'copy' number
39
# is added. 'copy' is 1 for the first student using a given student
40
# number sheet, then 2, and so on.
41
#
42
# Hence, a completed answer sheet is identified by the (student,copy)
43
# couple, and a printed sheet (and correct answers, scoring
44
# strategies) is identified by the student number only.
45
#
46
# 'question' is a number associated by LaTeX with every different
47
# question (based on the small text given as XXX in the
48
# \begin{question}{XXX} or \begin{questionmult}{XXX} commands).
49
#
50
# 'answer' is the answer number, starting from 1 for each question,
51
# before beeing shuffled.
52
53
# TABLES:
54
#
55
# title contains the titles (argument of the \begin{question} and
56
# \begin{questionmult} commands) of all the questions
57
#
58
# * question is the question number, as created by LaTeX and used in
59
#   the databases <layout>, <capture>.
60
#
61
# * title id the title of the question.
62
#
63
# default holds the default scoring strategies, as specified with the
64
# \scoringDefaultM and \scoringDefaultS commands in the LaTeX source
65
# file. This table contains 2 rows.
66
#
67
# * type is the question type, either QUESTION_SIMPLE or QUESTION_MULT
68
#   (these constants are defined in this module).
69
#
70
# * strategy is the default strategy string for this question type.
71
#
72
# main holds scoring strategies defined outside question/questionmult
73
# environments, either outside the onecopy/examcopy data (with
74
# student=-1), or inside (student=current student number).
75
#
76
# * student is the student number.
77
#
78
# * strategy is the strategy string given in the LaTeX file as an
79
#   argument of the \scoring command.
80
#
81
# question holds scoring strategies for questions.
82
#
83
# * student is the student number.
84
#
85
# * question is the question number.
86
#
87
# * type is the question type, either QUESTION_SIMPLE or
88
#   QUESTION_MULT
89
#
90
# * indicative is 1 if the question is indicative (the score is not
91
#   taken into account when computing the student mark).
92
#
93
# * strategy is the question scoring strategy string, given in the
94
#   LaTeX file inside the question/questionmult environment (but
95
#   before \correctchoice and \wrongchoice commands).
96
#
97
# answer holds scoring strategies concerning answers.
98
#
99
# * student is the student number.
100
#
101
# * question is the question number.
102
#
103
# * answer is the answer number, starting from 1 for each question.
104
#
105
# * correct is 1 if this choice is correct (use of \correctchoice).
106
#
107
# * strategy is the answer scoring strategy string, given in the LaTeX
108
#   file after the corresponding correctchoice/wrongchoice commands.
109
#
110
# score holds the questions scores for each student.
111
#
112
# * student is the student number.
113
#
114
# * copy is the copy number.
115
#
116
# * question is the question number.
117
#
118
# * score is the score resulting from applying the scoring strategy to
119
#   the student's answers.
120
#
121
# * why is a small string that is used to know when special cases has
122
#   been encountered:
123
#
124
#     E means syntax error (several boxes ticked for a simple
125
#     question, or " none of the above" AND another box ticked for a
126
#     multiple question).
127
#
128
#     V means that no box are ticked.
129
#
130
#     P means that a floor has been applied.
131
#
132
# * max is the question score associated to a copy where all answers
133
#   are correct (or 1 for indicative questions).
134
#
135
# mark holds global marks of the students.
136
#
137
# * student is the student number.
138
#
139
# * copy is the copy number.
140
#
141
# * total is the total score (sum of the questions scores).
142
#
143
# * max is the total score associated to a perfect copy.
144
#
145
# * mark is the student mark.
146
#
147
# code holds the codes entered by the students (see \AMCcode).
148
#
149
# * student is the student number.
150
#
151
# * copy is the copy number.
152
#
153
# * code is the code name.
154
#
155
# * value is the code value.
156
157
# VARIABLES:
158
#
159
# postcorrect_flag is 1 if the postcorrect mode is supposed to be used
160
# (correct answers are not indicated in the LaTeX source, but will be
161
# set from a teacher completed answer sheet).
162
#
163
# postcorrect_student
164
# postcorrect_copy    identify the sheet completed by the teacher.
165
#
166
# postcorrect_set_multiple (see postcorrect function)
167
#
168
# --- the following values are supplied in the Preferences window
169
#
170
# darkness_threshold and darkness_threshold_up are the parameters used
171
# for determining wether a box is ticked or not.
172
#
173
# mark_floor is the minimum mark to be given to a student.
174
#
175
# mark_max is the mark to be given to a perfect completed answer
176
# sheet.
177
#
178
# ceiling is true if AMC should put a ceiling on the students marks
179
# (this can be useful if the SUF global scoring strategy is used).
180
#
181
# rounding is the rounding type to be used for the marks.
182
#
183
# granularity is the granularity for the marks rounding.
184
185
use Exporter qw(import);
186
187
use constant {
188
  QUESTION_SIMPLE => 1,
189
  QUESTION_MULT => 2,
190
};
191
192
our @EXPORT_OK = qw(QUESTION_SIMPLE QUESTION_MULT);
193
our %EXPORT_TAGS = ( 'question' => [ qw/QUESTION_SIMPLE QUESTION_MULT/ ],
194
		   );
195
196
use AMC::Basic;
197
use AMC::DataModule;
198
use AMC::DataModule::capture ':zone';
199
use AMC::DataModule::layout ':flags';
200
201
use XML::Simple;
202
203
@ISA=("AMC::DataModule");
204
205
sub version_current {
206
  return(1);
207
}
208
209
sub version_upgrade {
210
    my ($self,$old_version)=@_;
211
    if($old_version==0) {
212
213
	# Upgrading from version 0 (empty database) to version 1 :
214
	# creates all the tables.
215
216
	debug "Creating scoring tables...";
217
	$self->sql_do("CREATE TABLE IF NOT EXISTS ".$self->table("title")
218
		      ." (question INTEGER, title TEXT)");
219
	$self->sql_do("CREATE TABLE IF NOT EXISTS ".$self->table("default")
220
		      ." (type INTEGER, strategy TEXT)");
221
	$self->sql_do("CREATE TABLE IF NOT EXISTS ".$self->table("main")
222
		      ." (student INTEGER, strategy TEXT)");
223
	$self->sql_do("CREATE TABLE IF NOT EXISTS ".$self->table("question")
224
		      ." (student INTEGER, question INTEGER, type INTEGER, indicative INTEGER DEFAULT 0, strategy TEXT, PRIMARY KEY (student,question))");
225
	$self->sql_do("CREATE TABLE IF NOT EXISTS ".$self->table("answer")
226
		      ." (student INTEGER, question INTEGER, answer INTEGER, correct INTEGER, strategy INTEGER, PRIMARY KEY (student,question,answer))");
227
	$self->sql_do("CREATE TABLE IF NOT EXISTS ".$self->table("alias")
228
		      ." (student INTEGER,see INTEGER)");
229
230
	$self->sql_do("CREATE TABLE IF NOT EXISTS ".$self->table("score")
231
		      ." (student INTEGER, copy INTEGER, question INTEGER, score REAL, why TEXT, max REAL, PRIMARY KEY (student,copy,question))");
232
	$self->sql_do("CREATE TABLE IF NOT EXISTS ".$self->table("mark")
233
		      ." (student INTEGER, copy INTEGER, total REAL, max REAL, mark REAL, PRIMARY KEY (student,copy))");
234
	$self->sql_do("CREATE TABLE IF NOT EXISTS ".$self->table("code")
235
		      ." (student INTEGER, copy INTEGER, code TEXT, value TEXT, PRIMARY KEY (student,copy,code))");
236
237
	$self->statement('NEWdefault')->execute(QUESTION_SIMPLE,"");
238
	$self->statement('NEWdefault')->execute(QUESTION_MULT,"");
239
240
	$self->populate_from_xml;
241
242
	return(1);
243
    }
244
    return('');
245
}
246
247
# populate_from_xml read the old format XML files (if any) and inserts
248
# them in the new SQLite database
249
250
sub populate_from_xml {
251
  my ($self)=@_;
252
  my $scoring_file=$self->{'data'}->directory;
253
  $scoring_file =~ s:/[^/]+/?$:/bareme.xml:;
254
  return if(!-f $scoring_file);
255
256
  $self->progression('begin',__"Fetching scoring data from old format XML files...");
257
258
  my $xml=XMLin($scoring_file,ForceArray => 1,KeyAttr=> [ 'id' ]);
259
260
  $self->main_strategy(-1,$xml->{'main'});
261
  my @s=(keys %{$xml->{'etudiant'}});
262
  my $frac=0;
263
264
  for my $student (@s) {
265
    my $s=$xml->{'etudiant'}->{$student};
266
    if($student eq 'defaut') {
267
      $self->default_strategy(QUESTION_SIMPLE,
268
			      $s->{'question'}->{'S'}->{'bareme'});
269
      $self->default_strategy(QUESTION_MULT,
270
			      $s->{'question'}->{'M'}->{'bareme'});
271
    } elsif($student =~ /^[0-9]+$/) {
272
      $self->main_strategy($student,$s->{'main'});
273
      for my $question (keys %{$s->{'question'}}) {
274
	if($question =~ /^[0-9]+$/) {
275
	  my $q=$s->{'question'}->{$question};
276
	  $self->question_title($question,$q->{'titre'});
277
	  $self->new_question
278
	    ($student,$question,
279
	     ($q->{'multiple'} ? QUESTION_MULT : QUESTION_SIMPLE),
280
	     ($q->{'indicative'} ? 1 : 0),$q->{'bareme'});
281
282
	  if($q->{'reponse'}) {
283
	    if(ref($q->{'reponse'}) eq 'HASH') {
284
	      for my $answer (keys %{$q->{'reponse'}}) {
285
		my $a=$q->{'reponse'}->{$answer};
286
		$self->new_answer($student,$question,$answer,
287
				  $a->{'bonne'},$a->{'bareme'});
288
	      }
289
	    } else {
290
	      debug "WARNING: reponse is not a HASHREF for S=$student Q=$question";
291
	    }
292
	  }
293
	} else {
294
	  debug "Unknown question id: <$question>";
295
	}
296
      }
297
    } else {
298
      debug "Unknown student id: <$student>";
299
    }
300
    $frac++;
301
    $self->progression('fraction',0.5*$frac/($#s+1));
302
  }
303
304
  $scoring_file=$self->{'data'}->directory;
305
  $scoring_file =~ s:/[^/]+/?$:/notes.xml:;
306
  return if(!-f $scoring_file);
307
308
  $frac=0;
309
310
  $xml=XMLin($scoring_file,ForceArray => 1,KeyAttr=> [ 'id' ]);
311
312
  $self->variable('darkness_threshold',$xml->{'seuil'});
313
  $self->variable('darkness_threshold_up',1.0);
314
  $self->variable('mark_floor',$xml->{'notemin'});
315
  $self->variable('mark_max',$xml->{'notemax'});
316
  $self->variable('ceiling',$xml->{'plafond'});
317
  $self->variable('rounding',$xml->{'arrondi'});
318
  $self->variable('granularity',$xml->{'grain'});
319
320
  @s=(keys %{$xml->{'copie'}});
321
  for my $student (@s) {
322
    my $s=$xml->{'copie'}->{$student};
323
324
    if($student =~ /^(moyenne|max)$/) {
325
      debug "Skipping student <$student>";
326
    } elsif($student =~ /^[0-9]+$/) {
327
      $self->statement('NEWMark')
328
	->execute($student,0,
329
		  map { $s->{'total'}->[0]->{$_} } (qw/total max note/));
330
331
      for my $title (keys %{$s->{'question'}}) {
332
	my $q=$s->{'question'}->{$title};
333
	my $question=$self->question_number($title);
334
	$self->statement('NEWScore')
335
	  ->execute($student,0,$question,
336
		    $q->{'note'},$q->{'max'},$q->{'raison'});
337
      }
338
339
      for my $code (keys %{$s->{'code'}}) {
340
	$self->statement('NEWCode')->execute($student,0,$code,
341
					     $s->{'code'}->{$code}->{'content'});
342
      }
343
    } else {
344
      debug "WARNING: Unknown student <$student> importing XML marks";
345
    }
346
    $frac++;
347
    $self->progression('fraction',0.5*(1+$frac/($#s+1)));
348
  }
349
350
  $self->progression('end');
351
}
352
353
# defines all the SQL statements that will be used
354
355
sub define_statements {
356
  my ($self)=@_;
357
  my $t_answer=$self->table("answer");
358
  my $t_default=$self->table("default");
359
  my $t_zone=$self->table("zone","capture");
360
  $self->{'statements'}=
361
    {
362
     'NEWdefault'=>{'sql'=>"INSERT INTO $t_default"
363
		    ." (type,strategy) VALUES (?,?)"},
364
     'getDefault'=>{'sql'=>"SELECT strategy FROM $t_default"
365
		    ." WHERE type=?"},
366
     'setDefault'=>{'sql'=>"UPDATE $t_default"
367
		    ." SET strategy=? WHERE type=?"},
368
     'noDefault'=>{'sql'=>"UPDATE $t_default"
369
		    ." SET strategy=''"},
370
     'NEWMain'=>{'sql'=>"INSERT INTO ".$self->table("main")
371
		  ." (student,strategy) VALUES (?,?)"},
372
     'getMain'=>{'sql'=>"SELECT strategy FROM ".$self->table("main")
373
		  ." WHERE student=?"},
374
     'getAllMain'=>{'sql'=>"SELECT strategy FROM ".$self->table("main")
375
		    ." WHERE student=? OR student=-1 OR student=0 ORDER BY student"},
376
     'setMain'=>{'sql'=>"UPDATE ".$self->table("main")
377
		  ." SET strategy=? WHERE student=?"},
378
     'NEWTitle'=>{'sql'=>"INSERT INTO ".$self->table("title")
379
		  ." (question,title) VALUES (?,?)"},
380
     'getTitle'=>{'sql'=>"SELECT title FROM ".$self->table("title")
381
		  ." WHERE question=?"},
382
     'getQNumber'=>{'sql'=>"SELECT question FROM ".$self->table("title")
383
		    ." WHERE title=?"},
384
     'setTitle'=>{'sql'=>"UPDATE ".$self->table("title")
385
		  ." SET title=? WHERE question=?"},
386
     'NEWQuestion'=>{'sql'=>"INSERT OR REPLACE INTO ".$self->table("question")
387
		     ." (student,question,type,indicative,strategy)"
388
		     ." VALUES (?,?,?,?,?)"},
389
     'NEWAnswer'=>{'sql'=>"INSERT OR REPLACE INTO ".$self->table("answer")
390
		   ." (student,question,answer,correct,strategy)"
391
		   ." VALUES (?,?,?,?,?)"},
392
     'setAnswerStrat'=>{'sql'=>"UPDATE ".$self->table("answer")
393
		       ." SET strategy=? WHERE student=? AND question=? AND answer=?"},
394
     'addAnswerStrat'=>{'sql'=>"UPDATE ".$self->table("answer")
395
			    ." SET strategy=strategy||? WHERE student=? AND question=? AND answer=?"},
396
     'NEWAlias'=>{'sql'=>"INSERT INTO ".$self->table("alias")
397
		  ." (student,see) VALUES (?,?)"},
398
     'getAlias'=>{'sql'=>"SELECT see FROM ".$self->table("alias")
399
		  ." WHERE student=?"},
400
     'postCorrectNew'=>{'sql'=>"CREATE TEMPORARY TABLE IF NOT EXISTS"
401
		       ." pc_temp (q INTEGER, a INTEGER, c REAL, PRIMARY KEY(q,a))"},
402
     'postCorrectClr'=>{'sql'=>"DELETE FROM pc_temp"},
403
     'postCorrectPop'=>{'sql'=>"INSERT INTO pc_temp (q,a,c) "
404
			." SELECT id_a,id_b,CASE"
405
			."   WHEN manual >= 0 THEN manual"
406
			."   WHEN total<=0 THEN -1"
407
			."   WHEN black >= ? * total AND black <= ? * total THEN 1"
408
			."   ELSE 0"
409
			." END"
410
			." FROM ".$self->table("zone","capture")
411
			." WHERE capture_zone.student=? AND capture_zone.copy=? AND capture_zone.type=?"},
412
     'postCorrectMul'=>{'sql'=>"UPDATE ".$self->table("question")
413
			." SET type=CASE"
414
			."   WHEN (SELECT sum(c) FROM pc_temp"
415
			."          WHERE q=question)>1"
416
			."   THEN ?"
417
			."   ELSE ?"
418
			." END"
419
		       },
420
     'postCorrectSet'=>{'sql'=>"UPDATE ".$self->table("answer")
421
			." SET correct=(SELECT c FROM pc_temp"
422
			."     WHERE q=question AND a=answer)"},
423
     'NEWScore'=>{'sql'=>"INSERT INTO ".$self->table("score")
424
		  ." (student,copy,question,score,max,why)"
425
		  ." VALUES (?,?,?,?,?,?)"},
426
     'cancelScore'=>{'sql'=>"UPDATE ".$self->table("score")
427
		     ." SET why=? WHERE student=? AND copy=? AND question=?"},
428
     'NEWMark'=>{'sql'=>"INSERT INTO ".$self->table("mark")
429
		  ." (student,copy,total,max,mark)"
430
		  ." VALUES (?,?,?,?,?)"},
431
     'NEWCode'=>{'sql'=>"INSERT INTO ".$self->table("code")
432
		  ." (student,copy,code,value)"
433
		  ." VALUES (?,?,?,?)"},
434
435
     'studentMark'=>{'sql'=>"SELECT * FROM ".$self->table("mark")
436
		     ." WHERE student=? AND copy=?"},
437
     'marks'=>{'sql'=>"SELECT * FROM ".$self->table("mark")},
438
     'marksCount'=>{'sql'=>"SELECT COUNT(*) FROM ".$self->table("mark")},
439
     'codes'=>{'sql'=>"SELECT code FROM ".$self->table("code")
440
	       ." GROUP BY code ORDER BY code"},
441
     'qStrat'=>{'sql'=>"SELECT strategy FROM ".$self->table("question")
442
		." WHERE student=? AND question=?"},
443
     'aStrat'=>{'sql'=>"SELECT strategy FROM ".$self->table("answer")
444
		." WHERE student=? AND question=? AND answer=?"},
445
     'answers'=>{'sql'=>"SELECT answer FROM ".$self->table("answer")
446
		 ." WHERE student=? AND question=?"
447
		." ORDER BY answer"},
448
     'studentQuestions'=>{'sql'=>"SELECT question FROM ".$self->table("question")
449
			  ." WHERE student=?"},
450
     'questions'=>{'sql'=>"SELECT question,title FROM ".$self->table("title")
451
		   ." ORDER BY title"},
452
     'qMaxMax'=>{'sql'=>"SELECT MAX(max) FROM ".$self->table("score")
453
		 ." WHERE question=?"},
454
     'correct'=>{'sql'=>"SELECT correct FROM ".$self->table("answer")
455
		 ." WHERE student=? AND question=? AND answer=?"},
456
     'correctForAll'=>{'sql'=>"SELECT question,answer,"
457
		       ." MIN(correct) AS correct_min,"
458
		       ." MAX(correct) AS correct_max "
459
		       ." FROM ".$self->table("answer")
460
		       ." GROUP BY question,answer"},
461
     'multiple'=>{'sql'=>"SELECT type FROM ".$self->table("question")
462
		 ." WHERE student=? AND question=?"},
463
     'indicative'=>{'sql'=>"SELECT indicative FROM ".$self->table("question")
464
		    ." WHERE student=? AND question=?"},
465
     'numQIndic'=>{'sql'=>"SELECT COUNT(*) FROM"
466
		   ." ( SELECT question FROM ".$self->table("question")
467
		   ." WHERE indicatve=? GROUP BY question)"},
468
     'oneIndic'=>{'sql'=>"SELECT COUNT(*) FROM ".$self->table("question")
469
		  ." WHERE question=? AND indicative=?"},
470
     'getScore'=>{'sql'=>"SELECT score FROM ".$self->table("score")
471
		  ." WHERE student=? AND copy=? AND question=?"},
472
     'getScoreC'=>{'sql'=>"SELECT score,max,why FROM ".$self->table("score")
473
		   ." WHERE student=? AND copy=? AND question=?"},
474
     'getCode'=>{'sql'=>"SELECT value FROM ".$self->table("code")
475
		  ." WHERE student=? AND copy=? AND code=?"},
476
     'codesCounts'=>{'sql'=>"SELECT student,copy,value,COUNT(*) as nb"
477
		     ." FROM ".$self->table("code")
478
		     ." WHERE code=? GROUP BY value"},
479
     'preAssocCounts'=>
480
     {'sql'=>"SELECT m.student,m.copy,l.id AS value,COUNT(*) AS nb"
481
      ." FROM ".$self->table("mark")." AS m"
482
      ."      , ".$self->table("association","layout")." AS l"
483
      ." ON m.student=l.student AND m.copy=0"
484
      ." GROUP BY l.id"},
485
486
     'avgMark'=>{'sql'=>"SELECT AVG(mark) FROM ".$self->table("mark")
487
		 ." WHERE NOT (student=? AND copy=?)"},
488
     'avgQuest'=>{'sql'=>"SELECT CASE"
489
		  ." WHEN SUM(max)>0 THEN 100*SUM(score)/SUM(max)"
490
		  ." ELSE '-' END"
491
		  ." FROM ".$self->table("score")
492
		  ." WHERE question=?"
493
		  ." AND NOT (student=? AND copy=?)"},
494
     'studentAnswersBase'=>
495
     {'sql'=>"SELECT question,answer"
496
      .",correct,strategy"
497
      .",(SELECT CASE"
498
      ."         WHEN manual >= 0 THEN manual"
499
      ."         WHEN total<=0 THEN -1"
500
      ."         WHEN black >= ? * total AND black <= ? * total THEN 1"
501
      ."         ELSE 0"
502
      ."  END FROM $t_zone"
503
      ."  WHERE $t_zone.student=? AND $t_zone.copy=? AND $t_zone.type=?"
504
      ."        AND $t_zone.id_a=$t_answer.question AND $t_zone.id_b=$t_answer.answer"
505
      ." ) AS ticked"
506
      ." FROM ".$self->table("answer")
507
      ." WHERE student=?"},
508
      'studentSkillLevel'=>
509
      {'sql'=>"SELECT SUBSTR(t.title, 1, INSTR(t.title, ':')-1) AS skill, SUM(s.score)/SUM(s.max)" 
510
       ." FROM ".$self->table("title"). " t" 
511
       ." INNER JOIN ".$self->table("score")." s" 
512
       ." ON s.question=t.question" 
513
       ." WHERE t.title LIKE '%:%' AND s.student=? AND s.copy=?" 
514
       ." GROUP BY s.copy, s.student, skill"},
515
     'studentQuestionsBase'=>
516
     {'sql'=>"SELECT q.question,q.type,q.indicative,q.strategy,t.title"
517
      .",d.strategy AS default_strategy"
518
      ." FROM ".$self->table("question"). " q"
519
      ." LEFT OUTER JOIN ".$self->table("default")." d"
520
      ." ON q.type=d.type"
521
      ." LEFT OUTER JOIN ".$self->table("title")." t"
522
      ." ON q.question=t.question"
523
      ." WHERE student=?"},
524
     'deleteScores'=>{'sql'=>"DELETE FROM ".$self->table('score')
525
		     ." WHERE student=? AND copy=?"},
526
     'deleteMarks'=>{'sql'=>"DELETE FROM ".$self->table('mark')
527
		    ." WHERE student=? AND copy=?"},
528
     'deleteCodes'=>{'sql'=>"DELETE FROM ".$self->table('code')
529
		    ." WHERE student=? AND copy=?"},
530
     'pagesWhy'=>{'sql'=>"SELECT s.student,s.copy,GROUP_CONCAT(s.why) as why,b.page FROM "
531
                  .$self->table('score')." s"
532
                  ." JOIN "
533
                  ." ( SELECT student,page,question FROM ".$self->table("box","layout")
534
                  ."   WHERE role=?"
535
                  ."   GROUP BY student,page,question )"
536
                  . " b"
537
                  ." ON s.student=b.student AND s.question=b.question"
538
                  ." GROUP BY s.student,b.page,s.copy"},
539
    };
540
}
541
542
# page_why() returns a list of items like
543
# {student=>1,copy=>0,page=>1,why=>',V,E,,'}
544
# that collects all 'why' attributes for questions that are on each page.
545
546
sub pages_why {
547
  my ($self)=@_;
548
  return(@{$self->dbh->selectall_arrayref($self->statement('pagesWhy'),
549
                                          {Slice=>{}},
550
                                          BOX_ROLE_ANSWER
551
                                         )});
552
}
553
554
555
# default_strategy($type) returns the default scoring strategy string
556
# to be used for questions with type $type (QUESTION_SIMPLE or
557
# QUESTION_MULT).
558
#
559
# default_strategy($type,$strategy) sets the default strategy string
560
# for questions with type $type.
561
562
sub default_strategy {
563
  my ($self,$type,$strategy)=@_;
564
  if(defined($strategy)) {
565
    $self->statement('setDefault')->execute($strategy,$type);
566
  } else {
567
    return($self->sql_single($self->statement('getDefault'),$type));
568
  }
569
}
570
571
# main_strategy($student) returns the main scoring strategy string for
572
# student $student. If $student<=0 (-1 in the database), this refers
573
# to the argument of the \scoring command used outside the
574
# onecopy/examcopy loop. If $student>0, this refers to the argument of
575
# the \scoring command used inside the onecopy/examcopy loop, but
576
# outside question/questionmult environments.
577
#
578
# main_strategy($student,$strategy) sets the main scoring strategy
579
# string.
580
581
sub main_strategy {
582
  my ($self,$student,$strategy)=@_;
583
  $student=-1 if($student<=0);
584
  if(defined($strategy)) {
585
    if(defined($self->main_strategy($student))) {
586
      $self->statement('setMain')->execute($strategy,$student);
587
    } else {
588
      $self->statement('NEWMain')->execute($student,$strategy);
589
    }
590
  } else {
591
    return($self->sql_single($self->statement('getMain'),$student));
592
  }
593
}
594
595
#add_main_strategy($student,$strategy) adds the strategy string at the
596
#end of the student's main strategy string.
597
598
sub add_main_strategy {
599
  my ($self,$student,$strategy)=@_;
600
  $student=-1 if($student<=0);
601
  my $old=$self->main_strategy($student);
602
  if(defined($old)) {
603
      $self->statement('setMain')->execute($old.','.$strategy,$student);
604
  } else {
605
      $self->statement('NEWMain')->execute($student,$strategy);
606
  }
607
}
608
609
# main_strategy_all($student) returns a concatenation of the the main
610
# strategies for student=-1, student=0 and student=$student.
611
612
sub main_strategy_all {
613
  my ($self,$student)=@_;
614
  return(join(',',$self->sql_list($self->statement('getAllMain'),$student)));
615
}
616
617
# new_question($student,$question,$type,$indicative,$strategy) adds a
618
# question in the database, giving its characteristics. If the
619
# question already exists, it is updated with no error.
620
621
sub new_question {
622
  my ($self,$student,$question,$type,$indicative,$strategy)=@_;
623
  $self->statement('NEWQuestion')->execute
624
    ($student,$question,$type,$indicative,$strategy);
625
}
626
627
# question_strategy($student,$question) returns the scoring strategy
628
# string for a particlar question: argument of the \scoring command
629
# used inside a question/questionmult environment, before the
630
# \correctchoice and \wrongchoice commands.
631
632
sub question_strategy {
633
  my ($self,$student,$question)=@_;
634
  return($self->sql_single($self->statement('qStrat'),$student,$question));
635
}
636
637
# new_answer($student,$question,$answer,$correct,$strategy) adds an
638
# answer in the database, giving its characteristics. If the answer
639
# already exists, it is updated with no error.
640
641
sub new_answer {
642
  my ($self,$student,$question,$answer,$correct,$strategy)=@_;
643
  $self->statement('NEWAnswer')->execute
644
    ($student,$question,$answer,$correct,$strategy);
645
}
646
647
# answer_strategy($student,$question,$answer) returns the scoring
648
# strategy string for a particular answer: argument of the \scoring
649
# command used after \correctchoice and \wrongchoice commands.
650
651
sub answer_strategy {
652
  my ($self,$student,$question,$answer)=@_;
653
  return($self->sql_single($self->statement('aStrat'),$student,$question,$answer));
654
}
655
656
# answers($student,$question) returns an ordered list of answers
657
# numbers for a particular question. Answer number 0, placed at the
658
# end, corresponds to the answer "None of the above", when present.
659
660
sub answers {
661
  my ($self,$student,$question)=@_;
662
  my @a=$self->sql_list($self->statement('answers'),$student,$question);
663
  if($a[0]==0) {
664
    shift @a;
665
    push @a,0;
666
  }
667
  return(@a);
668
}
669
670
# correct_answer($student,$question,$answer) returns 1 if the
671
# corresponding box has to be ticked (the answer is a correct one),
672
# and 0 if not.
673
674
sub correct_answer {
675
  my ($self,$student,$question,$answer)=@_;
676
  return($self->sql_single($self->statement('correct'),
677
			   $student,$question,$answer));
678
}
679
680
# correct_for_all() returns a reference to an array like
681
#
682
# [{question=>1,answer=>1,correct_min=>0,correct_max=>0},
683
#  {question=>1,answer=>2,correct_min=>1,correct_max=>1},
684
# ]
685
#
686
# This gives, for each question/answer, the minumum and maximum of the
687
# <correct> column for all students. Usualy, minimum and maximum are
688
# equal because the answer is either correct for all students either
689
# not correct for all students, but one can also encounter
690
# correct_min=0 and correct_max=1, in situations where the answers are
691
# not the same for all students (for example for questions with random
692
# numerical values).
693
694
sub correct_for_all {
695
  my ($self,$question,$answer)=@_;
696
  return($self->dbh->selectall_arrayref($self->statement('correctForAll'),
697
					{Slice=>{}}));
698
}
699
700
# multiple($student,$question) returns 1 if the corresponding
701
# question is multiple (type=QUESTION_MULT), and 0 if not.
702
703
sub multiple {
704
  my ($self,$student,$question)=@_;
705
  return($self->sql_single($self->statement('multiple'),
706
			   $student,$question) == QUESTION_MULT);
707
}
708
709
# correct_answer($student,$question) returns 1 if the corresponding
710
# question is indicative (use of \QuestionIndicative), and 0 if not.
711
712
sub indicative {
713
  my ($self,$student,$question)=@_;
714
  return($self->sql_single($self->statement('indicative'),
715
			   $student,$question));
716
}
717
718
# one_indicative($question,$indic) returns the number of students for
719
# which the question has indicative=$indic. In fact, a single question
720
# SHOULD be indicative for all students, or for none...
721
722
sub one_indicative {
723
  my ($self,$question,$indic)=@_;
724
  $indic=1 if(!defined($indic));
725
  return($self->sql_single($self->statement('oneIndic'),$question,$indic));
726
}
727
728
# num_questions_indic($i) returns the number of questions that have
729
# indicative=$i ($i is 0 or 1).
730
731
sub num_questions_indic {
732
  my ($self,$indicative)=@_;
733
  return($self->sql_single($self->statement('numQIndic'),$indicative));
734
}
735
736
# question_title($question) returns a question title.
737
#
738
# question_title($question,$title) sets a question title.
739
740
sub question_title {
741
  my ($self,$question,$title)=@_;
742
  if(defined($title)) {
743
    if(defined($self->question_title($question))) {
744
      $self->statement('setTitle')->execute($title,$question);
745
    } else {
746
      $self->statement('NEWTitle')->execute($question,$title);
747
    }
748
  } else {
749
    return($self->sql_single($self->statement('getTitle'),$question));
750
  }
751
}
752
753
# question_number($title) returns the question number corresponding to
754
# the given title.
755
756
sub question_number {
757
  my ($self,$title)=@_;
758
  return($self->sql_single($self->statement('getQNumber'),$title));
759
}
760
761
# question_maxmax($question) returns the maximum of the max value for
762
# question $question accross all students sheets
763
764
sub question_maxmax {
765
  my ($self,$question)=@_;
766
  return($self->sql_single($self->statement('qMaxMax'),$question));
767
}
768
769
# clear_strategy clears all data concerning the scoring strategy of
770
# the exam.
771
772
sub clear_strategy {
773
  my ($self)=@_;
774
  $self->clear_variables;
775
  $self->statement('noDefault')->execute;
776
  for my $t (qw/title main question answer alias/) {
777
    $self->sql_do("DELETE FROM ".$self->table($t));
778
  }
779
}
780
781
# clear_score clears all data concerning the scores/marks of the
782
# students.
783
784
sub clear_score {
785
  my ($self)=@_;
786
  for my $t (qw/score mark code/) {
787
    $self->sql_do("DELETE FROM ".$self->table($t));
788
  }
789
}
790
791
# set_answer_strategy($student,$question,$answer,$strategy) sets the
792
# scoring strategy string associated to a particular answer.
793
794
sub set_answer_strategy {
795
  my ($self,$student,$question,$answer,$strategy)=@_;
796
  $self->statement('setAnswerStrat')->execute($strategy,$student,$question,$answer);
797
}
798
799
# add_answer_strategy($student,$question,$answer,$strategy) adds the
800
# scoring strategy string to a particular answer's one.
801
802
sub add_answer_strategy {
803
  my ($self,$student,$question,$answer,$strategy)=@_;
804
  $self->statement('addAnswerStrat')->execute(",".$strategy,
805
					      $student,$question,$answer);
806
}
807
808
# replicate($see,$student) tells that the scoring strategy used for
809
# student $see has to be also used for student $student. This can be
810
# used only when the questions/answers are not different from a sheet
811
# to another (contrary to the use of random numerical values for
812
# exemple).
813
814
sub replicate {
815
  my ($self,$see,$student)=@_;
816
  $self->statement('NEWAlias')->execute($student,$see);
817
}
818
819
# unalias($student) gives the student number where to find scoring
820
# strategy for student $student (following a replicate path if
821
# present -- see previous method).
822
823
sub unalias {
824
  my ($self,$student)=@_;
825
  my $s=$student;
826
  do {
827
    $student=$s;
828
    $s=$self->sql_single($self->statement('getAlias'),$student);
829
  } while(defined($s));
830
  return($student);
831
}
832
833
# postcorrect($student,$copy,$darkness_threshold,$darkness_threshold_up,$set_multiple)
834
# uses the ticked values from the copy ($student,$copy) (filled by a
835
# teacher) to determine which answers are correct for all sheets. This
836
# can be used only when the questions/answers are not different from a
837
# sheet to another (contrary to the use of random numerical values for
838
# exemple).
839
#
840
# If $set_multiple is true, postcorrect also sets the type of all
841
# questions for which 2 or more answers are ticked on the
842
# ($student,$copy) answer sheet to be QUESTION_MULT, ans the type of
843
# all other questions to QUESTION_SIMPLE.
844
845
sub postcorrect {
846
  my ($self,$student,$copy,
847
      $darkness_threshold,$darkness_threshold_up,$set_multiple)=@_;
848
  die "Missing parameters in postcorrect call"
849
    if(!defined($darkness_threshold_up));
850
  $self->{'data'}->require_module('capture');
851
  $self->statement('postCorrectNew')->execute();
852
  $self->statement('postCorrectClr')->execute();
853
  $self->statement('postCorrectPop')
854
    ->execute($darkness_threshold,$darkness_threshold_up,$student,$copy,ZONE_BOX);
855
  $self->statement('postCorrectMul')->execute(QUESTION_MULT,QUESTION_SIMPLE)
856
    if($set_multiple);
857
  $self->statement('postCorrectSet')->execute();
858
}
859
860
# new_score($student,$copy,$question,$score,$score_max,$why) adds a
861
# question score row.
862
863
sub new_score {
864
  my ($self,$student,$copy,$question,$score,$score_max,$why)=@_;
865
  $self->statement('NEWScore')
866
    ->execute($student,$copy,$question,$score,$score_max,$why);
867
}
868
869
# cancel_score($student,$copy,$question) cancels scoring (sets the
870
# score and maximum score to zero) for this question.
871
872
sub cancel_score {
873
  my ($self,$student,$copy,$question)=@_;
874
  $self->statement('cancelScore')
875
    ->execute('C',$student,$copy,$question);
876
}
877
878
# new_mark($student,$copy,$total,$max,$mark) adds a mark row.
879
880
sub new_mark {
881
  my ($self,$student,$copy,$total,$max,$mark)=@_;
882
  $self->statement('NEWMark')
883
    ->execute($student,$copy,$total,$max,$mark);
884
}
885
886
# new_code($student,$copy,$code,$value) adds a code row.
887
888
sub new_code {
889
  my ($self,$student,$copy,$code,$value)=@_;
890
  $self->statement('NEWCode')
891
    ->execute($student,$copy,$code,$value);
892
}
893
894
# student_questions($student) returns a list of the question numbers
895
# used in the sheets for student number $student.
896
897
sub student_questions {
898
  my ($self,$student)=@_;
899
  return($self->sql_list($self->statement('studentQuestions'),
900
			 $student));
901
}
902
903
# questions returns an array of pointers (one for each question) to
904
# hashes ('question'=><question_number>,'title'=>'question_title').
905
906
sub questions {
907
  my ($self)=@_;
908
  return(@{$self->dbh->selectall_arrayref($self->statement('questions'),{Slice=>{}})});
909
}
910
911
# average_mark returns the average mark from all students marks.
912
913
sub average_mark {
914
  my ($self)=@_;
915
  my @pc=$self->postcorrect_sc;
916
  return($self->sql_single($self->statement('avgMark'),@pc));
917
}
918
919
# codes returns a list of codes names.
920
921
sub codes {
922
  my ($self)=@_;
923
  return($self->sql_list($self->statement('codes')));
924
}
925
926
# marks returns a pointer to an array of pointers (one for each
927
# student) to hashes giving all information from the mark table.
928
929
sub marks {
930
  my ($self)=@_;
931
  return(@{$self->dbh->selectall_arrayref($self->statement('marks'),{Slice=>{}})});
932
}
933
934
# marks_count returns the nmber of marks computed.
935
936
sub marks_count {
937
  my ($self)=@_;
938
  return($self->sql_single($self->statement('marksCount')));
939
}
940
941
# question_score($student,$copy,$question) returns the score of a
942
# particular student for a particular question.
943
944
sub question_score {
945
  my ($self,$student,$copy,$question)=@_;
946
  return($self->sql_single($self->statement('getScore'),
947
			   $student,$copy,$question));
948
}
949
950
# question_result($student,$copy,$question) returns a pointer to a
951
# hash ('score'=>XXX,'max'=>XXX,'why'=>XXX) extracted from the
952
# question table.
953
954
sub question_result {
955
  my ($self,$student,$copy,$question)=@_;
956
  my $sth=$self->statement('getScoreC');
957
  $sth->execute($student,$copy,$question);
958
  return($sth->fetchrow_hashref);
959
}
960
961
# student_code($student,$copy,$code) returns the value of the code
962
# named $code entered by a particular student.
963
964
sub student_code {
965
  my ($self,$student,$copy,$code)=@_;
966
  return($self->sql_single($self->statement('getCode'),
967
			   $student,$copy,$code));
968
}
969
970
# postcorrect_sc returns (postcorrect_student,postcorrect_copy), or
971
# (0,0) if not in postcorrect mode.
972
973
sub postcorrect_sc {
974
  my ($self)=@_;
975
  return($self->variable('postcorrect_student') || 0,
976
	 $self->variable('postcorrect_copy') || 0);
977
}
978
979
# question_average($question) returns the average (as a percentage of
980
# the maximum score, from 0 to 100) of the scores for a particular
981
# question.
982
983
sub question_average {
984
  my ($self,$question)=@_;
985
  my @pc=$self->postcorrect_sc;
986
  return($self->sql_single($self->statement('avgQuest'),$question,
987
			   @pc));
988
}
989
990
# student_global($student,$copy) returns a pointer to a hash
991
# ('student'=>XXX,'copy'=>XXX,'total'=>XXX,'max'=>XXX,'mark'=>XXX)
992
# extracted from the mark table.
993
994
sub student_global {
995
  my ($self,$student,$copy)=@_;
996
  my $sth=$self->statement('studentMark');
997
  $sth->execute($student,$copy);
998
  return($x=$sth->fetchrow_hashref);
999
}
1000
1001
# student_scoring_base($student,$copy,$darkness_threshold,$darkness_threshold_up)
1002
# returns useful data to compute questions scores for a particular
1003
# student (identified by $student and $copy), as a reference to a hash
1004
# grouping questions and answers. For exemple :
1005
#
1006
# 'main_strategy'=>"",
1007
# 'questions'=>
1008
# { 1 =>{ 'question'=>1,
1009
#         'type'=>1,
1010
#         'indicative'=>0,
1011
#         'strategy'=>'',
1012
#         'answers'=>[ { 'question'=>1, 'answer'=>1,
1013
#                        'correct'=>1, 'ticked'=>0, 'strategy'=>"b=2" },
1014
#                      {'question'=>1, 'answer'=>2,
1015
#                        'correct'=>0, 'ticked'=>0, 'strategy'=>"" },
1016
#                    ],
1017
#       },
1018
#  ...
1019
# }
1020
1021
sub student_scoring_base {
1022
  my ($self,$student,$copy,$darkness_threshold,$darkness_threshold_up)=@_;
1023
  die "Missing parameters in student_scoring_base call"
1024
    if(!defined($darkness_threshold_up));
1025
  $self->{'data'}->require_module('capture');
1026
  my $student_strategy=$self->unalias($student);
1027
  my $r={'student_alias'=>$student_strategy,
1028
	 'questions'=>{},
1029
	 'main_strategy'=>$self->main_strategy_all($student_strategy)};
1030
  my @sid=($student);
1031
  push @sid,$student_strategy if($student != $student_strategy);
1032
  for my $s (@sid) {
1033
    my $sth;
1034
    $sth=$self->statement('studentQuestionsBase');
1035
    $sth->execute($s);
1036
    while(my $qa=$sth->fetchrow_hashref) {
1037
      $r->{'questions'}->{$qa->{'question'}}=$qa;
1038
    }
1039
    $sth=$self->statement('studentAnswersBase');
1040
    $sth->execute($darkness_threshold,$darkness_threshold_up,
1041
		  $student,$copy,ZONE_BOX,$s);
1042
    while(my $qa=$sth->fetchrow_hashref) {
1043
      push @{$r->{'questions'}->{$qa->{'question'}}->{'answers'}},$qa;
1044
    }
1045
  }
1046
  return($r);
1047
}
1048
1049
# delete_scoring_data($student,$copy) deletes all scoring data
1050
# relative to a particular answer sheet.
1051
1052
sub delete_scoring_data {
1053
  my ($self,$student,$copy)=@_;
1054
  for my $part (qw/Scores Marks Codes/) {
1055
    $self->statement('delete'.$part)->execute($student,$copy);
1056
  }
1057
}
1058
1059
1;