scoring.pm

DENIS Sébastien, 12/09/2018 03:27 pm

Download (38.1 kB)

 
1
# -*- perl -*-
2
#
3
# Copyright (C) 2011-2017 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
     'correctChars'=>
457
     {sql=>"SELECT char FROM "
458
      ." (SELECT answer FROM ".$self->table("answer")
459
      ."  WHERE student=? AND question=? AND correct>0) AS correct,"
460
      ." (SELECT answer,char FROM ".$self->table("box","layout")
461
      ."  WHERE student=? AND question=? AND role=?) AS char"
462
      ." ON correct.answer=char.answer ORDER BY correct.answer"},
463
     'correctForAll'=>{'sql'=>"SELECT question,answer,"
464
		       ." MIN(correct) AS correct_min,"
465
		       ." MAX(correct) AS correct_max "
466
		       ." FROM ".$self->table("answer")
467
		       ." GROUP BY question,answer"},
468
     'multiple'=>{'sql'=>"SELECT type FROM ".$self->table("question")
469
		 ." WHERE student=? AND question=?"},
470
     'indicative'=>{'sql'=>"SELECT indicative FROM ".$self->table("question")
471
		    ." WHERE student=? AND question=?"},
472
     'numQIndic'=>{'sql'=>"SELECT COUNT(*) FROM"
473
		   ." ( SELECT question FROM ".$self->table("question")
474
		   ." WHERE indicatve=? GROUP BY question)"},
475
     'oneIndic'=>{'sql'=>"SELECT COUNT(*) FROM ".$self->table("question")
476
		  ." WHERE question=? AND indicative=?"},
477
     'getScore'=>{'sql'=>"SELECT score FROM ".$self->table("score")
478
		  ." WHERE student=? AND copy=? AND question=?"},
479
     'getScoreC'=>{'sql'=>"SELECT score,max,why FROM ".$self->table("score")
480
		   ." WHERE student=? AND copy=? AND question=?"},
481
     'getCode'=>{'sql'=>"SELECT value FROM ".$self->table("code")
482
		  ." WHERE student=? AND copy=? AND code=?"},
483
     'codesCounts'=>{'sql'=>"SELECT student,copy,value,COUNT(*) as nb"
484
		     ." FROM ".$self->table("code")
485
		     ." WHERE code=? GROUP BY value"},
486
     'preAssocCounts'=>
487
     {'sql'=>"SELECT m.student,m.copy,l.id AS value,COUNT(*) AS nb"
488
      ." FROM ".$self->table("mark")." AS m"
489
      ."      , ".$self->table("association","layout")." AS l"
490
      ." ON m.student=l.student AND m.copy=0"
491
      ." GROUP BY l.id"},
492
493
     'avgMark'=>{'sql'=>"SELECT AVG(mark) FROM ".$self->table("mark")
494
		 ." WHERE NOT (student=? AND copy=?)"},
495
     'avgQuest'=>{'sql'=>"SELECT CASE"
496
		  ." WHEN SUM(max)>0 THEN 100*SUM(score)/SUM(max)"
497
		  ." ELSE '-' END"
498
		  ." FROM ".$self->table("score")
499
		  ." WHERE question=?"
500
		  ." AND NOT (student=? AND copy=?)"},
501
     'studentAnswersBase'=>
502
     {'sql'=>"SELECT question,answer"
503
      .",correct,strategy"
504
      .",(SELECT CASE"
505
      ."         WHEN manual >= 0 THEN manual"
506
      ."         WHEN total<=0 THEN -1"
507
      ."         WHEN black >= ? * total AND black <= ? * total THEN 1"
508
      ."         ELSE 0"
509
      ."  END FROM $t_zone"
510
      ."  WHERE $t_zone.student=? AND $t_zone.copy=? AND $t_zone.type=?"
511
      ."        AND $t_zone.id_a=$t_answer.question AND $t_zone.id_b=$t_answer.answer"
512
      ." ) AS ticked"
513
      ." FROM ".$self->table("answer")
514
      ." WHERE student=?"},
515
     'studentSkillLevel'=>
516
     {'sql'=>"SELECT SUBSTR(t.title, 1, INSTR(t.title, ':')-1) AS skill, SUM(s.score)/SUM(s.max)"
517
      ." FROM ".$self->table("title"). " t"
518
      ." INNER JOIN ".$self->table("score")." s"
519
      ." ON s.question=t.question"
520
      ." WHERE t.title LIKE '%:%' AND s.student=? AND s.copy=?"
521
      ." GROUP BY s.copy, s.student, skill"},
522
     'studentQuestionsBase'=>
523
     {'sql'=>"SELECT q.question,q.type,q.indicative,q.strategy,t.title"
524
      .",d.strategy AS default_strategy"
525
      ." FROM ".$self->table("question"). " q"
526
      ." LEFT OUTER JOIN ".$self->table("default")." d"
527
      ." ON q.type=d.type"
528
      ." LEFT OUTER JOIN ".$self->table("title")." t"
529
      ." ON q.question=t.question"
530
      ." WHERE student=?"},
531
     'deleteScores'=>{'sql'=>"DELETE FROM ".$self->table('score')
532
		     ." WHERE student=? AND copy=?"},
533
     'deleteMarks'=>{'sql'=>"DELETE FROM ".$self->table('mark')
534
		    ." WHERE student=? AND copy=?"},
535
     'deleteCodes'=>{'sql'=>"DELETE FROM ".$self->table('code')
536
		    ." WHERE student=? AND copy=?"},
537
     'pagesWhy'=>{'sql'=>"SELECT s.student,s.copy,GROUP_CONCAT(s.why) as why,b.page FROM "
538
                  .$self->table('score')." s"
539
                  ." JOIN "
540
                  ." ( SELECT student,page,question FROM ".$self->table("box","layout")
541
                  ."   WHERE role=?"
542
                  ."   GROUP BY student,page,question )"
543
                  . " b"
544
                  ." ON s.student=b.student AND s.question=b.question"
545
                  ." GROUP BY s.student,b.page,s.copy"},
546
    };
547
}
548
549
# page_why() returns a list of items like
550
# {student=>1,copy=>0,page=>1,why=>',V,E,,'}
551
# that collects all 'why' attributes for questions that are on each page.
552
553
sub pages_why {
554
  my ($self)=@_;
555
  return(@{$self->dbh->selectall_arrayref($self->statement('pagesWhy'),
556
                                          {Slice=>{}},
557
                                          BOX_ROLE_ANSWER
558
                                         )});
559
}
560
561
562
# default_strategy($type) returns the default scoring strategy string
563
# to be used for questions with type $type (QUESTION_SIMPLE or
564
# QUESTION_MULT).
565
#
566
# default_strategy($type,$strategy) sets the default strategy string
567
# for questions with type $type.
568
569
sub default_strategy {
570
  my ($self,$type,$strategy)=@_;
571
  if(defined($strategy)) {
572
    $self->statement('setDefault')->execute($strategy,$type);
573
  } else {
574
    return($self->sql_single($self->statement('getDefault'),$type));
575
  }
576
}
577
578
# main_strategy($student) returns the main scoring strategy string for
579
# student $student. If $student<=0 (-1 in the database), this refers
580
# to the argument of the \scoring command used outside the
581
# onecopy/examcopy loop. If $student>0, this refers to the argument of
582
# the \scoring command used inside the onecopy/examcopy loop, but
583
# outside question/questionmult environments.
584
#
585
# main_strategy($student,$strategy) sets the main scoring strategy
586
# string.
587
588
sub main_strategy {
589
  my ($self,$student,$strategy)=@_;
590
  $student=-1 if($student<=0);
591
  if(defined($strategy)) {
592
    if(defined($self->main_strategy($student))) {
593
      $self->statement('setMain')->execute($strategy,$student);
594
    } else {
595
      $self->statement('NEWMain')->execute($student,$strategy);
596
    }
597
  } else {
598
    return($self->sql_single($self->statement('getMain'),$student));
599
  }
600
}
601
602
#add_main_strategy($student,$strategy) adds the strategy string at the
603
#end of the student's main strategy string.
604
605
sub add_main_strategy {
606
  my ($self,$student,$strategy)=@_;
607
  $student=-1 if($student<=0);
608
  my $old=$self->main_strategy($student);
609
  if(defined($old)) {
610
      $self->statement('setMain')->execute($old.','.$strategy,$student);
611
  } else {
612
      $self->statement('NEWMain')->execute($student,$strategy);
613
  }
614
}
615
616
# main_strategy_all($student) returns a concatenation of the the main
617
# strategies for student=-1, student=0 and student=$student.
618
619
sub main_strategy_all {
620
  my ($self,$student)=@_;
621
  return(join(',',$self->sql_list($self->statement('getAllMain'),$student)));
622
}
623
624
# new_question($student,$question,$type,$indicative,$strategy) adds a
625
# question in the database, giving its characteristics. If the
626
# question already exists, it is updated with no error.
627
628
sub new_question {
629
  my ($self,$student,$question,$type,$indicative,$strategy)=@_;
630
  $self->statement('NEWQuestion')->execute
631
    ($student,$question,$type,$indicative,$strategy);
632
}
633
634
# question_strategy($student,$question) returns the scoring strategy
635
# string for a particlar question: argument of the \scoring command
636
# used inside a question/questionmult environment, before the
637
# \correctchoice and \wrongchoice commands.
638
639
sub question_strategy {
640
  my ($self,$student,$question)=@_;
641
  return($self->sql_single($self->statement('qStrat'),$student,$question));
642
}
643
644
# new_answer($student,$question,$answer,$correct,$strategy) adds an
645
# answer in the database, giving its characteristics. If the answer
646
# already exists, it is updated with no error.
647
648
sub new_answer {
649
  my ($self,$student,$question,$answer,$correct,$strategy)=@_;
650
  $self->statement('NEWAnswer')->execute
651
    ($student,$question,$answer,$correct,$strategy);
652
}
653
654
# answer_strategy($student,$question,$answer) returns the scoring
655
# strategy string for a particular answer: argument of the \scoring
656
# command used after \correctchoice and \wrongchoice commands.
657
658
sub answer_strategy {
659
  my ($self,$student,$question,$answer)=@_;
660
  return($self->sql_single($self->statement('aStrat'),$student,$question,$answer));
661
}
662
663
# answers($student,$question) returns an ordered list of answers
664
# numbers for a particular question. Answer number 0, placed at the
665
# end, corresponds to the answer "None of the above", when present.
666
667
sub answers {
668
  my ($self,$student,$question)=@_;
669
  my @a=$self->sql_list($self->statement('answers'),$student,$question);
670
  if($a[0]==0) {
671
    shift @a;
672
    push @a,0;
673
  }
674
  return(@a);
675
}
676
677
# correct_answer($student,$question,$answer) returns 1 if the
678
# corresponding box has to be ticked (the answer is a correct one),
679
# and 0 if not.
680
681
sub correct_answer {
682
  my ($self,$student,$question,$answer)=@_;
683
  return($self->sql_single($self->statement('correct'),
684
			   $student,$question,$answer));
685
}
686
687
# correct_chars($student,$question) returns the list of the chars
688
# written inside (or beside) the boxes corresponding to correct
689
# answers for a particular question
690
691
sub correct_chars {
692
  my ($self,$student,$question)=@_;
693
  $self->{'data'}->require_module('layout');
694
  return($self->sql_list($self->statement('correctChars'),
695
                         $student,$question,
696
                         $student,$question,BOX_ROLE_ANSWER));
697
}
698
699
# Same as correct_chars, but paste the chars if they all exist, and
700
# return undef otherwise
701
702
sub correct_chars_pasted {
703
  my ($self,@args)=@_;
704
  my @c=$self->correct_chars(@args);
705
  if(grep { !defined($_) } @c) {
706
    return(undef);
707
  } else {
708
    return(join("",@c));
709
  }
710
}
711
712
# correct_for_all() returns a reference to an array like
713
#
714
# [{question=>1,answer=>1,correct_min=>0,correct_max=>0},
715
#  {question=>1,answer=>2,correct_min=>1,correct_max=>1},
716
# ]
717
#
718
# This gives, for each question/answer, the minumum and maximum of the
719
# <correct> column for all students. Usualy, minimum and maximum are
720
# equal because the answer is either correct for all students either
721
# not correct for all students, but one can also encounter
722
# correct_min=0 and correct_max=1, in situations where the answers are
723
# not the same for all students (for example for questions with random
724
# numerical values).
725
726
sub correct_for_all {
727
  my ($self,$question,$answer)=@_;
728
  return($self->dbh->selectall_arrayref($self->statement('correctForAll'),
729
					{Slice=>{}}));
730
}
731
732
# multiple($student,$question) returns 1 if the corresponding
733
# question is multiple (type=QUESTION_MULT), and 0 if not.
734
735
sub multiple {
736
  my ($self,$student,$question)=@_;
737
  return($self->sql_single($self->statement('multiple'),
738
			   $student,$question) == QUESTION_MULT);
739
}
740
741
# correct_answer($student,$question) returns 1 if the corresponding
742
# question is indicative (use of \QuestionIndicative), and 0 if not.
743
744
sub indicative {
745
  my ($self,$student,$question)=@_;
746
  return($self->sql_single($self->statement('indicative'),
747
			   $student,$question));
748
}
749
750
# one_indicative($question,$indic) returns the number of students for
751
# which the question has indicative=$indic. In fact, a single question
752
# SHOULD be indicative for all students, or for none...
753
754
sub one_indicative {
755
  my ($self,$question,$indic)=@_;
756
  $indic=1 if(!defined($indic));
757
  return($self->sql_single($self->statement('oneIndic'),$question,$indic));
758
}
759
760
# num_questions_indic($i) returns the number of questions that have
761
# indicative=$i ($i is 0 or 1).
762
763
sub num_questions_indic {
764
  my ($self,$indicative)=@_;
765
  return($self->sql_single($self->statement('numQIndic'),$indicative));
766
}
767
768
# question_title($question) returns a question title.
769
#
770
# question_title($question,$title) sets a question title.
771
772
sub question_title {
773
  my ($self,$question,$title)=@_;
774
  if(defined($title)) {
775
    if(defined($self->question_title($question))) {
776
      $self->statement('setTitle')->execute($title,$question);
777
    } else {
778
      $self->statement('NEWTitle')->execute($question,$title);
779
    }
780
  } else {
781
    return($self->sql_single($self->statement('getTitle'),$question));
782
  }
783
}
784
785
# question_number($title) returns the question number corresponding to
786
# the given title.
787
788
sub question_number {
789
  my ($self,$title)=@_;
790
  return($self->sql_single($self->statement('getQNumber'),$title));
791
}
792
793
# question_maxmax($question) returns the maximum of the max value for
794
# question $question accross all students sheets
795
796
sub question_maxmax {
797
  my ($self,$question)=@_;
798
  return($self->sql_single($self->statement('qMaxMax'),$question));
799
}
800
801
# clear_strategy clears all data concerning the scoring strategy of
802
# the exam.
803
804
sub clear_strategy {
805
  my ($self)=@_;
806
  $self->clear_variables;
807
  $self->statement('noDefault')->execute;
808
  for my $t (qw/title main question answer alias/) {
809
    $self->sql_do("DELETE FROM ".$self->table($t));
810
  }
811
}
812
813
# clear_score clears all data concerning the scores/marks of the
814
# students.
815
816
sub clear_score {
817
  my ($self)=@_;
818
  for my $t (qw/score mark code/) {
819
    $self->sql_do("DELETE FROM ".$self->table($t));
820
  }
821
}
822
823
# set_answer_strategy($student,$question,$answer,$strategy) sets the
824
# scoring strategy string associated to a particular answer.
825
826
sub set_answer_strategy {
827
  my ($self,$student,$question,$answer,$strategy)=@_;
828
  $self->statement('setAnswerStrat')->execute($strategy,$student,$question,$answer);
829
}
830
831
# add_answer_strategy($student,$question,$answer,$strategy) adds the
832
# scoring strategy string to a particular answer's one.
833
834
sub add_answer_strategy {
835
  my ($self,$student,$question,$answer,$strategy)=@_;
836
  $self->statement('addAnswerStrat')->execute(",".$strategy,
837
					      $student,$question,$answer);
838
}
839
840
# replicate($see,$student) tells that the scoring strategy used for
841
# student $see has to be also used for student $student. This can be
842
# used only when the questions/answers are not different from a sheet
843
# to another (contrary to the use of random numerical values for
844
# exemple).
845
846
sub replicate {
847
  my ($self,$see,$student)=@_;
848
  $self->statement('NEWAlias')->execute($student,$see);
849
}
850
851
# unalias($student) gives the student number where to find scoring
852
# strategy for student $student (following a replicate path if
853
# present -- see previous method).
854
855
sub unalias {
856
  my ($self,$student)=@_;
857
  my $s=$student;
858
  do {
859
    $student=$s;
860
    $s=$self->sql_single($self->statement('getAlias'),$student);
861
  } while(defined($s));
862
  return($student);
863
}
864
865
# postcorrect($student,$copy,$darkness_threshold,$darkness_threshold_up,$set_multiple)
866
# uses the ticked values from the copy ($student,$copy) (filled by a
867
# teacher) to determine which answers are correct for all sheets. This
868
# can be used only when the questions/answers are not different from a
869
# sheet to another (contrary to the use of random numerical values for
870
# exemple).
871
#
872
# If $set_multiple is true, postcorrect also sets the type of all
873
# questions for which 2 or more answers are ticked on the
874
# ($student,$copy) answer sheet to be QUESTION_MULT, ans the type of
875
# all other questions to QUESTION_SIMPLE.
876
877
sub postcorrect {
878
  my ($self,$student,$copy,
879
      $darkness_threshold,$darkness_threshold_up,$set_multiple)=@_;
880
  die "Missing parameters in postcorrect call"
881
    if(!defined($darkness_threshold_up));
882
  $self->{'data'}->require_module('capture');
883
  $self->statement('postCorrectNew')->execute();
884
  $self->statement('postCorrectClr')->execute();
885
  $self->statement('postCorrectPop')
886
    ->execute($darkness_threshold,$darkness_threshold_up,$student,$copy,ZONE_BOX);
887
  $self->statement('postCorrectMul')->execute(QUESTION_MULT,QUESTION_SIMPLE)
888
    if($set_multiple);
889
  $self->statement('postCorrectSet')->execute();
890
}
891
892
# new_score($student,$copy,$question,$score,$score_max,$why) adds a
893
# question score row.
894
895
sub new_score {
896
  my ($self,$student,$copy,$question,$score,$score_max,$why)=@_;
897
  $self->statement('NEWScore')
898
    ->execute($student,$copy,$question,$score,$score_max,$why);
899
}
900
901
# cancel_score($student,$copy,$question) cancels scoring (sets the
902
# score and maximum score to zero) for this question.
903
904
sub cancel_score {
905
  my ($self,$student,$copy,$question)=@_;
906
  $self->statement('cancelScore')
907
    ->execute('C',$student,$copy,$question);
908
}
909
910
# new_mark($student,$copy,$total,$max,$mark) adds a mark row.
911
912
sub new_mark {
913
  my ($self,$student,$copy,$total,$max,$mark)=@_;
914
  $self->statement('NEWMark')
915
    ->execute($student,$copy,$total,$max,$mark);
916
}
917
918
# new_code($student,$copy,$code,$value) adds a code row.
919
920
sub new_code {
921
  my ($self,$student,$copy,$code,$value)=@_;
922
  $self->statement('NEWCode')
923
    ->execute($student,$copy,$code,$value);
924
}
925
926
# student_questions($student) returns a list of the question numbers
927
# used in the sheets for student number $student.
928
929
sub student_questions {
930
  my ($self,$student)=@_;
931
  return($self->sql_list($self->statement('studentQuestions'),
932
			 $student));
933
}
934
935
# questions returns an array of pointers (one for each question) to
936
# hashes ('question'=><question_number>,'title'=>'question_title').
937
938
sub questions {
939
  my ($self)=@_;
940
  return(@{$self->dbh->selectall_arrayref($self->statement('questions'),{Slice=>{}})});
941
}
942
943
# average_mark returns the average mark from all students marks.
944
945
sub average_mark {
946
  my ($self)=@_;
947
  my @pc=$self->postcorrect_sc;
948
  return($self->sql_single($self->statement('avgMark'),@pc));
949
}
950
951
# codes returns a list of codes names.
952
953
sub codes {
954
  my ($self)=@_;
955
  return($self->sql_list($self->statement('codes')));
956
}
957
958
# marks returns a pointer to an array of pointers (one for each
959
# student) to hashes giving all information from the mark table.
960
961
sub marks {
962
  my ($self)=@_;
963
  return(@{$self->dbh->selectall_arrayref($self->statement('marks'),{Slice=>{}})});
964
}
965
966
# marks_count returns the nmber of marks computed.
967
968
sub marks_count {
969
  my ($self)=@_;
970
  return($self->sql_single($self->statement('marksCount')));
971
}
972
973
# question_score($student,$copy,$question) returns the score of a
974
# particular student for a particular question.
975
976
sub question_score {
977
  my ($self,$student,$copy,$question)=@_;
978
  return($self->sql_single($self->statement('getScore'),
979
			   $student,$copy,$question));
980
}
981
982
# question_result($student,$copy,$question) returns a pointer to a
983
# hash ('score'=>XXX,'max'=>XXX,'why'=>XXX) extracted from the
984
# question table.
985
986
sub question_result {
987
  my ($self,$student,$copy,$question)=@_;
988
  my $sth=$self->statement('getScoreC');
989
  $sth->execute($student,$copy,$question);
990
  return($sth->fetchrow_hashref);
991
}
992
993
# student_code($student,$copy,$code) returns the value of the code
994
# named $code entered by a particular student.
995
996
sub student_code {
997
  my ($self,$student,$copy,$code)=@_;
998
  return($self->sql_single($self->statement('getCode'),
999
			   $student,$copy,$code));
1000
}
1001
1002
# postcorrect_sc returns (postcorrect_student,postcorrect_copy), or
1003
# (0,0) if not in postcorrect mode.
1004
1005
sub postcorrect_sc {
1006
  my ($self)=@_;
1007
  return($self->variable('postcorrect_student') || 0,
1008
	 $self->variable('postcorrect_copy') || 0);
1009
}
1010
1011
# question_average($question) returns the average (as a percentage of
1012
# the maximum score, from 0 to 100) of the scores for a particular
1013
# question.
1014
1015
sub question_average {
1016
  my ($self,$question)=@_;
1017
  my @pc=$self->postcorrect_sc;
1018
  return($self->sql_single($self->statement('avgQuest'),$question,
1019
			   @pc));
1020
}
1021
1022
# student_global($student,$copy) returns a pointer to a hash
1023
# ('student'=>XXX,'copy'=>XXX,'total'=>XXX,'max'=>XXX,'mark'=>XXX)
1024
# extracted from the mark table.
1025
1026
sub student_global {
1027
  my ($self,$student,$copy)=@_;
1028
  my $sth=$self->statement('studentMark');
1029
  $sth->execute($student,$copy);
1030
  return($x=$sth->fetchrow_hashref);
1031
}
1032
1033
# student_scoring_base($student,$copy,$darkness_threshold,$darkness_threshold_up)
1034
# returns useful data to compute questions scores for a particular
1035
# student (identified by $student and $copy), as a reference to a hash
1036
# grouping questions and answers. For exemple :
1037
#
1038
# 'main_strategy'=>"",
1039
# 'questions'=>
1040
# { 1 =>{ 'question'=>1,
1041
#         'title' => 'questionID',
1042
#         'type'=>1,
1043
#         'indicative'=>0,
1044
#         'strategy'=>'',
1045
#         'answers'=>[ { 'question'=>1, 'answer'=>1,
1046
#                        'correct'=>1, 'ticked'=>0, 'strategy'=>"b=2" },
1047
#                      {'question'=>1, 'answer'=>2,
1048
#                        'correct'=>0, 'ticked'=>0, 'strategy'=>"" },
1049
#                    ],
1050
#       },
1051
#  ...
1052
# }
1053
1054
sub student_scoring_base {
1055
  my ($self,$student,$copy,$darkness_threshold,$darkness_threshold_up)=@_;
1056
  die "Missing parameters in student_scoring_base call"
1057
    if(!defined($darkness_threshold_up));
1058
  $self->{'data'}->require_module('capture');
1059
  my $student_strategy=$self->unalias($student);
1060
  my $r={'student_alias'=>$student_strategy,
1061
	 'questions'=>{},
1062
	 'main_strategy'=>$self->main_strategy_all($student_strategy)};
1063
  my @sid=($student);
1064
  push @sid,$student_strategy if($student != $student_strategy);
1065
  for my $s (@sid) {
1066
    my $sth;
1067
    $sth=$self->statement('studentQuestionsBase');
1068
    $sth->execute($s);
1069
    while(my $qa=$sth->fetchrow_hashref) {
1070
      $r->{'questions'}->{$qa->{'question'}}=$qa;
1071
    }
1072
    $sth=$self->statement('studentAnswersBase');
1073
    $sth->execute($darkness_threshold,$darkness_threshold_up,
1074
		  $student,$copy,ZONE_BOX,$s);
1075
    while(my $qa=$sth->fetchrow_hashref) {
1076
      push @{$r->{'questions'}->{$qa->{'question'}}->{'answers'}},$qa;
1077
    }
1078
  }
1079
  return($r);
1080
}
1081
1082
# student_scoring_base_sorted(...) organizes the data from
1083
# student_scoring_base to get sorted questions, relative to their IDs
1084
# (lexicographic order)
1085
#
1086
# 'main_strategy'=>"",
1087
# 'questions'=>
1088
# [ { 'question'=>1,
1089
#     'title' => 'questionID',
1090
#     'type'=>1,
1091
#     'indicative'=>0,
1092
#     'strategy'=>'',
1093
#     'answers'=>[ { 'question'=>1, 'answer'=>1,
1094
#                    'correct'=>1, 'ticked'=>0, 'strategy'=>"b=2" },
1095
#                  {'question'=>1, 'answer'=>2,
1096
#                    'correct'=>0, 'ticked'=>0, 'strategy'=>"" },
1097
#                ],
1098
#   },
1099
#  ...
1100
# ]
1101
1102
sub student_scoring_base_sorted {
1103
  my ($self,@args)=@_;
1104
1105
  my $ssb=$self->student_scoring_base(@args);
1106
  my @n=sort { $ssb->{questions}->{$a}->{title}
1107
                 cmp $ssb->{questions}->{$b}->{title} }
1108
    (keys %{$ssb->{questions}});
1109
  my $sorted_q=[map { $ssb->{questions}->{$_} } (@n)];
1110
  $ssb->{questions}=$sorted_q;
1111
1112
  return($ssb);
1113
}
1114
1115
# delete_scoring_data($student,$copy) deletes all scoring data
1116
# relative to a particular answer sheet.
1117
1118
sub delete_scoring_data {
1119
  my ($self,$student,$copy)=@_;
1120
  for my $part (qw/Scores Marks Codes/) {
1121
    $self->statement('delete'.$part)->execute($student,$copy);
1122
  }
1123
}
1124
1125
1;