#!/usr/bin/perl # qz - generic quiz script # # Copyright (C) 1996-2008 by John J. Chew, III # All Rights Reserved. ## table of contents # libraries # naming convention # global constants # global variables # parameters that a configuration file can safely override # subroutines # main code ## libraries require 'getopts.pl'; use strict; use warnings; ## naming convention # # k'name global constant # config'name configuration constant # gName global variable (should be put in a package) # tName temporary variable (should be changed to 'my' variables) # name 'my' variable ## ## global constants ## # field names in quiz files, number of fields *k'fQuestion = \0; *k'fAnswer = \1; *k'fRating = \2; *k'fAge = \3; *k'fFlags = \4; *k'fNote = \5; *k'fields = \6; # version number for this script *k'version = \'3.0.16'; # 3.0.16 - ;S reports final stats while running # 3.0.15 - corrected final stats when filters running # 3.0.14 - answer filter # 3.0.13 - question filter # 3.0.12 - report age of new questions correctly # 3.0.11 - show average age # 3.0.10 - detect some new versions of Windows # 3.0.9 - report question age after correct answer # 3.0.8 - fix statistical report formatting bug # 3.0.7 - allow directory names on command line ## ## configuration constants ## @config'default_fields_2 = ('+100', 0, 'C', ''); # fields to add if user has hand-edited a line containing just question and answer into file $config'max_rating = 100; # maximum difficulty rating in seconds $config'mri = 15; # minimum interval between repeats $config'notes = 'notes.txt'; # external notes database $config::question_filter = sub { 1 }; # pattern questions must match $config::answer_filter = sub { 1 }; # pattern answer must match $config'program = 'jjc'; # default program $config'typing_speed = 9; # user typing speed in characters per second %config'programs = ( 'hardest', '100;0;0;0', 'oldest', '0;100;0;0', 'random', '0;0;100;0', 'jjc', '30;20;40;10', ); %config'program_help = ( 'hardest', 'do all questions from hardest to easiest', 'oldest', 'do all questions from oldest to newest', 'random', 'pick at random, biased toward hard questions', 'jjc', '20% oldest, 20% hardest, 50% random, 10% review', ); ## ## global variables ## $| = 1; # if unset, prompt won't display properly on resume from TSTP # environment: unknown, unix, dos my $gEnvironment = undef; # 'unix', 'dos', 'mac' my $gDBMSuffix = undef; $_ = $::ENV{'PATH'}; if (defined &MacPerl::Quit) { $gEnvironment = 'mac'; $gDBMSuffix = ''; print "\n\245\245\245 qz $k'version \245\245\245\n"; { my @argv = split(/\s+/, (split(/:/, $0))[-1]); shift @argv; unshift(@::ARGV, @argv); } print join(' ', 'qz', @::ARGV), "\n"; } # if mac environment elsif (/^\//) { $gEnvironment = 'unix'; $gDBMSuffix = '.dir'; } elsif (/^[A-Z]:\\/i) { $gEnvironment = 'dos'; $gDBMSuffix = '.db'; } else { die "Unknown environment, please contact jjchew\@math.utoronto.ca\n"; } # chronological list of numbers of questions answered incorrectly my @gErrors = (); # map file number to question count, dirty flag or filename my @gFileNum_Dirty = (); my @gFileNum_FileName = (); my @gFileNum_QuestionCount = (); # store data for question $n as follows: # $gQData[$k'fields*$n+$k'fQuestion] = question text # $gQData[$k'fields*$n+$k'fAnswer ] = answer text # $gQData[$k'fields*$n+$k'fRating ] = moving mean response time or # '+' . $config'max_rating+1 if new # $gQData[$k'fields*$n+$k'fAge ] = time() of last correct answer # $gQData[$k'fields*$n+$k'fFlags ] = flags: # 'C' if case of answer doesn't matter # 'O' if order of words in answer doesn't matter # $gQData[$k'fields*$n+$k'fNote ] = note to display after answer my @gQData = (); # list of question numbers sorted chronologically by last correct answer my @gQByAge = (); # map difficulty rating to list of space-separated question numbers my @gQByRating = (); # number of questions my $gQCount = 0; # number of questions, rounded up to a power of two my $gQCount2 = 0; # number of questions answered correctly my $gQCorrect = 0; # notes to display after question is answered (question\tnote\n...) my $gNotes = ''; # time at start of session (seconds since epoch) my $gSessionStart; # tricky data structure defined as follows: # # gRT(x) := $gRatingTree[$x]; r(x) := rating of question $x # gRT(0)=r(0); gRT(1)=r(0)+r(1); gRT(2)=r(2); gRT(3)=r(0)+r(1)+r(2)+r(3) # gRT(4)=r(4); gRT(5)=r(4)+r(5); gRT(6)=r(6); gRT(7)=r(0)+...+r(7)... # i.e. gRT(2k)=r(2k); gRT(4k+1)=r(4k)+r(4k+1); gRT(8k+3)=r(8k)+...r(8k+3) # and in general, gRT((2k+1)*2**n-1)=sum i (2k*2**n..(2k+1)*2**n-1) r(i) # # This gives us linear data structure initialization and log n searches # and data structure updates; a big improvement over the old linear search. # # Thanks to my brain for thinking of this. my @gRatingTree = (); ## prompt-related variables $prompt'lastq = undef;# last question asked $prompt'note = undef; # text of note associated with current question $prompt'qord = 0; # 1-based ordinal number of current question $prompt'text = ''; # prompt text $prompt'resumed = 0; # set whenever we return from a TSTP $prompt'start = undef;# time when current question was asked $prompt'waiting = 0; # true if a prompt needs redisplaying after a TSTP # total of all difficulty ratings my $gTotalRating = 0; # total time spent answering questions my $gTotalTime = 0; # question number to when question was asked in this session my @gWhenAsked = (); ## subroutines sub AskHardest(); # $rc = AskHardest # ask hardest question sub AskOldest(); # $rc = AskOldest # ask oldest question sub AskQ($); # $res = AskQ($qNumber) # ask a question sub AskRandom(); # $rc = AskRandom # ask random question sub AskReview(); # $rc = AskReview # ask review question sub DoAddQuestion(@); # DoAddQuestion @ARGV # process '-a' sub DoAddQuestions(@); # DoAddQuestions @ARGV # process '-A' sub DoDeleteQuestion(@); # DoDeleteQuestion @ARGV # process '-d' sub DoListQuestions(@); # DoListQuestions @ARGV # process '-l' sub DoListStats(); # DoListStats # process '-L' sub DoRunQuiz(@); # DoRunQuiz # run a quiz sub EOpenFile(*$); # EOpenFile(*H, $fns) # open(H, $fns) safely sub FormatRating($); # $s=FormatRating($r) # fmt 'new' or numeric sub FormatTime($); # $s=FormatTime $t # fmt time interval sub GiveUp($); # 0=GiveUp($qnum) # record give up for this q sub GotIt($$); # 0=GotIt($qnum) # record correct for this q sub HandleTSTP($); # # TSTP signal handler sub JoinPath(@); # $path=JoinPath(d,d,f) # OS-independent pathname builder sub LoadData(@); # LoadData(@files) # load quiz data sub Main(); # Main # run main code sub MungeData(); # MungeData # munge input quiz data sub ParseCommandLine (); # ParseCommandLine # parse command line sub ReadLine($$); # ReadLine($time,$lc) # prompt for a line of input sub S(); # s # show final stats sub SaveData(); # SaveData # save quiz data sub SetRating($$); # SetRating($qnum,$r) # set question's rating sub TouchQ($); # TouchQ($qnum) # mark a question as dirty sub Usage(); # Usage # display help and die # $rc = AskHardest() - ask the currently hardest-rated question # returns # 0 if question was asked successfully # 1 if no question could be found # 2 if user has requested end of quiz sub AskHardest() { my $rating = $#gQByRating; while ($rating >= 0) { next unless length($gQByRating[$rating]); for my $q (split(/ /, $gQByRating[$rating])) { next unless $prompt'qord - $gWhenAsked[$q] >= $config'mri; my $result = AskQ $q; if ($result == 0) { return 0; } # asked if ($result == 1) { return 2; } # EOF # if ($result == 2) { continue; } # did not match pattern } } continue { $rating--; } 1; } # $rc = AskOldest() - ask the currently oldest question # returns # 0 if question was asked successfully # 1 if no question could be found # 2 if user has requested end of quiz sub AskOldest() { for my $q (@gQByAge) { next unless $prompt'qord - $gWhenAsked[$q] >= $config'mri; my $result = AskQ $q; if ($result == 0) { return 0; } # asked if ($result == 1) { return 2; } # EOF # if ($result == 2) { continue; } # did not match pattern } 1; } # $result = AskQ($qNumber) - ask a question # # returns 0 if question was asked # returns 1 if user signalled end of file # returns 2 if question did not match filter and could not be asked sub AskQ ($) { my ($q) = @_; die "Oops ($q >= $gQCount)\nAborting" if $q >= $gQCount; my ($answer, $flags, $question); { my $qIndex = $q * $k'fields; $flags = $gQData[$qIndex+$k'fFlags]; $answer = $gQData[$qIndex+$k'fAnswer]; $answer = lc $answer if $flags =~ /C/; $question = $gQData[$qIndex+$k'fQuestion]; return 2 unless &$config::question_filter($question) && &$config::answer_filter($answer); $prompt'note = $gNotes =~ /^\Q$question\E\t(.*)/m ? $1 : ''; $prompt'note = length($prompt'note) ? "$prompt'note\n$gQData[$qIndex+$k'fNote]" : $gQData[$qIndex+$k'fNote]; $prompt'note =~ s/^\n//; $prompt'note =~ s/
|

/\n/g; $prompt'text = sprintf("[%d] %s: ", ++$prompt'qord, $question); } my $time = 0; $gWhenAsked[$q] = $prompt'qord; if ($flags =~ /O/) { # don't care about order my (%answer, %found); my $count = 0; for my $word (split(/\s+/, $answer)) { $answer{$word} = 1; $count++; } my $originalCount = $count; my $isFirstQ = 1; while ($count > 0) { unless ($isFirstQ) { print %found ? "Enter another answer, or press return to see them all.\n" : "Press return to see the correct answer, or try again.\n"; } my $read = (ReadLine $time, ($flags =~ /C/)); defined $read ? chop $read : return 1; $isFirstQ = 0; ($read =~ /\S/) || return GiveUp $q; for my $word (split(/\s+/, $read)) { $answer{$word} ? $found{$word}++ ? print("You have already entered `$word'.\n") : $count-- : print("`$word' is not correct.\n"); } } } else { # not in unordered mode my $read = ReadLine $time, ($flags =~ /C/); defined $read ? chop $read : return 1; $read eq $answer || return GiveUp $q; } GotIt $q, $time; } # $rc = AskRandom() - ask a question at random, weighting for difficulty # returns # 0 if question was asked successfully # 1 if the selected question's timer hasn't yet expired # 2 if user has requested end of quiz sub AskRandom() { for my $i (1..20) { my $rand = rand($gTotalRating); my $q = 0; my $width = $gQCount2; while ($width > 1) { $width >>= 1; my $mid = $q + $width; if ($mid <= $gQCount && $rand >= $gRatingTree[$mid-1]) { $rand -= $gRatingTree[$mid-1]; $q = $mid; } } if ($prompt'qord - $gWhenAsked[$q] >= $config'mri) { my $result = AskQ $q; if ($result == 0) { return 0; } # asked if ($result == 1) { return 2; } # EOF # if ($result == 2) { continue; } # did not match pattern } } 1; } # $rc = AskReview() - ask a review question, from the recent errors list # returns # 0 if question was asked successfully # 1 if the selected question's timer hasn't yet expired, or if no errors # 2 if user has requested end of quiz sub AskReview() { ($#gErrors>=0 && $prompt'qord-$gWhenAsked[$gErrors[0]] >= $config'mri) ? ( (AskQ shift @gErrors) ? 2 : 0 ) : 1; } # DoAddQuestion(@ARGV) # process '-a question answer flags note file.qz' # by adding a question to a file, creating file if necessary sub DoAddQuestion(@) { my @argv = @_; my @fields; $fields[$k'fQuestion] = shift @argv; $fields[$k'fAnswer] = shift @argv; $fields[$k'fRating] = '+' . ($config'max_rating+1); $fields[$k'fAge] = 0; $fields[$k'fFlags] = shift @argv; $fields[$k'fNote] = shift @argv; LoadData @argv; { my $qIndex = $k'fQuestion; # look to see if question already exists while ($qIndex <= $#gQData) { last if $fields[$k'fQuestion] eq $gQData[$qIndex]; $qIndex += $k'fields; } # up the question count if question is new $gFileNum_QuestionCount[0]++ if $qIndex > $#gQData; # store new fields in global array $qIndex -= $k'fQuestion; @gQData[$qIndex..$qIndex+$k'fields-1] = @fields; } # my $qIndex # mark question file as dirty TouchQ 0; SaveData; } # DoAddQuestion # DoAddQuestions(@ARGV) # process '-A [input-file] file.qz' # by adding questions from the input file # (each lines looks like: question tab answer tab flags tab note) sub DoAddQuestions(@) { my @argv = @_; my $inputFile = $#argv > 0 ? shift @argv : '-'; my (@fields); # constant fields $fields[$k'fRating] = '+' . ($config'max_rating+1); $fields[$k'fAge] = 0; LoadData @argv; EOpenFile *IN, "<$inputFile"; while () { chop; @_ = split(/\t/); die "Wrong number of fields in this line:\n$_\nAborting" unless $#_ == $k'fields - 1; $fields[$k'fQuestion] = $_[0]; $fields[$k'fAnswer] = $_[1]; $fields[$k'fFlags] = $_[2]; $fields[$k'fNote] = $_[3]; { my $qIndex = $k'fQuestion; while ($qIndex <= $#gQData) { last if $_[0] eq $gQData[$qIndex]; $qIndex += $k'fields; } $gFileNum_QuestionCount[0]++ if $qIndex > $#gQData; $qIndex -= $k'fQuestion; @gQData[$qIndex..$qIndex+$k'fields-1] = @fields; } } close(IN); # mark question file as dirty TouchQ 0; SaveData; } # DoAddQuestions # DoDeleteQuestion(@ARGV) # process '-d question file.qz' # by deleting a question from a file sub DoDeleteQuestion(@) { my @argv = @_; my $question = shift @argv; LoadData @argv; { my $qIndex = $k'fQuestion; while ($qIndex <= $#gQData) { last if $question eq $gQData[$qIndex]; $qIndex += $k'fields; } die "No such question: '$question'\n" unless $qIndex <= $#gQData; $gFileNum_QuestionCount[0]--; # delete data splice(@gQData, $qIndex-$k'fQuestion, $k'fields); } # mark question file as dirty TouchQ 0; SaveData; } # DoDeleteQuestion # DoListQuestions(@ARGV) # process '-l file.qz...' # by listing all questions in named files sub DoListQuestions(@) { my @argv = @_; LoadData @argv; # measure field widths my @tWidths = (0) x $k'fields; { my $fieldIndex = 0; for my $tField (@gQData) { my $length = ($fieldIndex == $k'fRating && $tField =~ /^\+/) ? 3 : length($tField); $tWidths[$fieldIndex] = $length if $tWidths[$fieldIndex] < $length; $fieldIndex = 0 if ++$fieldIndex == $k'fields; } } # build printf format my $fmt = '%' . $tWidths[$k'fRating ] .'s '. '%-' . $tWidths[$k'fQuestion] .'.'. $tWidths[$k'fQuestion] . 's '. '%-' . $tWidths[$k'fAnswer ] .'.'. $tWidths[$k'fAnswer ] . 's '; my $indent = ' ' x ($tWidths[$k'fRating] + $tWidths[$k'fQuestion] + 13); for my $q (sort { $gQData[$k'fRating+$k'fields*$b] <=> $gQData[$k'fRating+$k'fields*$a] || $gQData[$k'fAge+$k'fields*$b] <=> $gQData[$k'fAge+$k'fields*$a] } 0..$gQCount-1) { my $qIndex = $q * $k'fields; if ($gQData[$_ = $qIndex + $k'fAge]) { my @data = localtime($gQData[$_]); printf "%04d-%02d-%02d ", $data[5]+1900, $data[4]+1, $data[3]; } else { print "-not-seen- "; } printf $fmt, (FormatRating $gQData[$qIndex + $k'fRating]), $gQData[$qIndex + $k'fQuestion], $gQData[$qIndex + $k'fAnswer]; print "\n"; $_ = $gQData[$qIndex + $k'fNote]; print "$indent$_\n" if length($_); } } # DoListQuestions # DoListStats - list file stats sub DoListStats () { my $solved = 0; my $totalRating = 0; my $unseen = 0; my $unsolved = 0; my $age_sum = 0; my $now = time; my $count = 0; # calculate stats { my $qIndex = $k'fRating; my $offsetq = $k'fQuestion - $k'fRating; my $offseta = $k'fAnswer - $k'fRating; my $offsetage = $k'fAge - $k'fRating; while ($qIndex <= $#gQData) { next unless &$config::question_filter($gQData[$qIndex + $offsetq]) && &$config::answer_filter($gQData[$qIndex + $offseta]); $age_sum += $gQData[$qIndex+$offsetage]; $count++; my $rating = $gQData[$qIndex]; if ($rating =~ /^\+/) { $unseen++; } elsif ($rating == $config'max_rating) { $unsolved++; } else { $solved++; $totalRating += $rating; } } continue { $qIndex += $k'fields; } } # print report my $seen = $solved + $unsolved; printf "Total: %d\n", $unseen+$seen; printf "Unseen: %d (%d%%)\n", $unseen, 0.5+100*($unseen/($seen+$unseen)) if $unseen; print "Solved: $solved"; printf " (%d%%)", 0.5+100*$solved/$seen if $seen; print "\nUnsolved: $unsolved"; printf " (%d%%)", 0.5+100*$unsolved/$seen if $seen; print "\n"; printf "Mean solution time: %.1f s\n", $totalRating/$solved if $solved; printf "Mean difficulty: %.1f s\n", (100*($unsolved+$unseen)+$totalRating)/($seen+$unseen) if $unsolved || $unseen; print "Mean solution age: ", FormatTime(int($now - $age_sum/$count)), "\n" if $count; my $t = 0; { my $i = 0; my $offsetq = $k'fQuestion - $k'fAge; my $offseta = $k'fAnswer - $k'fAge; while ($i <= $#gQByAge) { my $qIndex = $gQByAge[$i++]*$k'fields + $k'fAge; next unless &$config::question_filter($gQData[$qIndex + $offsetq]) && &$config::answer_filter($gQData[$qIndex + $offseta]); $t = $gQData[$qIndex]; last; } } print "Oldest solution: ", ($t ? FormatTime($now-$t) : 'never'), "\n"; } # DoListStats # DoRunQuiz(@ARGV) # process 'qz file.qz...' # by running a quiz sub DoRunQuiz(@) { my @argv = @_; $SIG{'TSTP'} = \&HandleTSTP if $gEnvironment eq 'unix'; $gSessionStart = time; # load external notes if necessary if (defined $config'notes) { EOpenFile(*NOTES, '<'.$config'notes); local($/) = undef; $gNotes = ; close(NOTES); } # load data @argv = <*.qz> if $#argv == -1; LoadData @argv; if ($gQCount <= 0) { print "There are no questions in the files you specified.\n"; exit 0; } MungeData; if (time - $gSessionStart > 2) { print "Press return to begin.\n"; $_ = ; } # normalise algorithm distribution my @algProbs = split(/;/, $config'programs{$config'program}, 4); { my $tS = 0; for my $t (@algProbs) { $tS += $t; } for my $t (@algProbs) { $t /= $tS; } } $gQCorrect = 0; $prompt'qord = 0; $gTotalTime = 0; my $tries = 0; $gSessionStart = time; ask:while (1) { # pick an algorithm my $algorithm = 0; { my $t = rand; while ($t>0) { $t -= $algProbs[$algorithm++]; } $algorithm--; } # ask the question my $rc = &{(\&AskHardest,\&AskOldest,\&AskRandom,\&AskReview)[$algorithm]}; if ($rc == 1) { if ($algorithm <=1 ) { print "No more questions available.\n"; last ask; } else { $tries++; next ask; } } elsif ($rc == 2) { last ask; } $tries = 0; } continue { if ($tries >= 20) { print "Giving up after $tries tries at picking a question.\n"; last; } } SaveData; $prompt'qord--; &S; } # EOpenFile(*HANDLE, " $config'max_rating && ($newRating = $config'max_rating); print "$prompt'note\n" if length($prompt'note); print 'Correct. (' . ($oldAge ? (FormatTime time-$oldAge) : 'never') . ':' . (FormatRating $oldRating) . "-$newRating)\n"; $gQCorrect++; # update question fields SetRating $q, $newRating; } # update chronological list { my $low = 0; my $high = $gQCount; while ($high - $low > 1) { my $mid = int(($low + $high) / 2); my $comp = $gQData[$gQByAge[$mid]*$k'fields+$k'fAge] <=> $oldAge; if ($comp < 0) { $low = $mid; } elsif ($comp > 0) { $high = $mid; } else { $low = $high = $mid; last; } } while ($gQData[$gQByAge[$low]*$k'fields+$k'fAge] == $oldAge && $low > 0) { $low--; } while ($gQData[$gQByAge[$high]*$k'fields+$k'fAge] == $oldAge && $high < $gQCount-1) { $high++; } { my $tQ = $low; while ($tQ<=$high) { if ($gQByAge[$tQ] == $q) { push(@gQByAge, splice(@gQByAge, $tQ, 1)); last; } $tQ++; } } } TouchQ $q; $prompt'lastq = $q; 0; } # HandleTSTP() - TSTP signal handler sub HandleTSTP ($) { $SIG{'TSTP'} = \&HandleTSTP; my $stopped_at = time; kill 'STOP', $$; if ($prompt'waiting) { $prompt'start += time - $stopped_at; print $prompt'text; } $prompt'resumed = 1; } sub JoinPath (@) { join( $gEnvironment eq 'mac' ? ':' : $gEnvironment eq 'unix' ? '/' : $gEnvironment eq 'dos' ? '\\' : die, @_); } # LoadData - load quiz data sub LoadData (@) { my (@files) = @_; # first expand directory names (3.0.7) { my $i; for ($i=0; $i<=$#files; $i++) { next unless -d $files[$i]; opendir(DIR, $files[$i]) || die "$files[$i]: can't read directory: $!\n"; my @subfiles = grep( (!/^\.{1,2}$/) && (/\.qz$/||-d (JoinPath $files[$i], $_)), readdir(DIR)); closedir(DIR); for my $sf (@subfiles) { $sf = JoinPath $files[$i], $sf; } splice(@files, $i, 1, @subfiles); } # for ($i=0;...) } # my $i $gQCount = 0; for my $file (@files) { my $fileQCount = 0; EOpenFile *IN, "<$file"; while () { chomp; my @fields = split(/\t/, $_, 100); if ($#fields == -1) { next; } elsif ($#fields == 1) { push(@fields, @config'default_fields_2); } die "$file line $.: Can't parse line:\n$_\n" . "Expected $k'fields fields, got $#fields+1.\nAborting" unless $#fields == $k'fields-1; push(@gQData, @fields); $gQCount++; $fileQCount++; } # while () close(IN); push(@gFileNum_Dirty, 0); push(@gFileNum_FileName, $file); push(@gFileNum_QuestionCount, $fileQCount); } # for my $file } # MungeData - precalculate information useful for running a quiz sub MungeData () { # round $gQCount up to a power of two for ($gQCount2 = 1; $gQCount2 < $gQCount; $gQCount2 <<= 1) { } # calculate rating information @gQByRating = ('') x ($config'max_rating + 2); # ($u0,$s0) = times; # DEBUG $gTotalRating = 0; { my $q = 0; my $qIndex = $k'fRating; while ($q<$gQCount) { # a fun loop my $rating = $gQData[$qIndex]; $gTotalRating += $gRatingTree[$q] = $rating; $gQByRating[$rating] .= "$q "; next unless $q % 2; my $t1 = $q-1; $gRatingTree[$q] += $gRatingTree[$t1]; my $t2 = 1; my $t3 = $q & (1 + $q); while (($t1-=$t2) > $t3) { $t2 += $t2; $gRatingTree[$q] += $gRatingTree[$t1]; } } continue { $q++; $qIndex += $k'fields; } } # ($u1,$s1) = times; printf "time: %5.2f %5.2f\n", $u1-$u0, $s1-$s0; # DEBUG # build chronological list { $#gQByAge = $gQCount - 1; my $q = $gQCount; my $qIndex = $q * $k'fields + $k'fAge; while ($q-- > 0) { $gQByAge[$q] = $qIndex -= $k'fields; } } # perl 5.10.0 segfaults if the following line is in the preceding block. # if placed here, it silently fails when returning from MungeData. # @gQByAge = sort { $gQData[$a] <=> $gQData[$b] || int(rand(3))-1; } @gQByAge; # It works fine if you don't do the sort in place: my (@perl510sux) = sort { $gQData[$a] <=> $gQData[$b] || int(rand(3))-1; } @gQByAge; @gQByAge = @perl510sux; for my $q1 (@gQByAge) { $q1 = int($q1/$k'fields); } # build last-asked list @gWhenAsked = (-$config'mri) x $gQCount; } # ParseCommandLine - parse command line sub ParseCommandLine () { # initialize variables to help avoid -w warnings $::opt_a = $::opt_d = $::opt_h = $::opt_i = $::opt_l = $::opt_n = $::opt_r = $::opt_s = $::opt_v = $::opt_A = $::opt_L = 0; $::opt_f = $::opt_m = $::opt_n = $::opt_p = $::opt_r = $::opt_M = undef; &Getopts('adf:hilm:n:p:r:svALM:-:') || Usage; # -: avoids warning in getopts.pl # check for incompatible arguments ($::opt_a+$::opt_d+$::opt_l+$::opt_A+$::opt_L > 1) && Usage; # check argument count ( $::opt_a ? $#ARGV != 4 : $::opt_d ? $#ARGV != 3 : $::opt_l ? $#ARGV < 0 : $::opt_A ? ($#ARGV < 0 || $#ARGV > 1) : $::opt_L ? $#ARGV < 0 : 0 ) && Usage; # -a: handled in main code # -d: handled in main code # -f file: obsolete if (defined $::opt_f) { warn "The `-f' flag is no longer supported;\n". "please just list quiz files on the command line instead.\n"; push(@ARGV, $::opt_f); } # -h: display help $::opt_h && Usage; # -i: obsolete if ($::opt_i) { warn "The `-i' flag is no longer supported; please use the 'O' question flag instead.\n"; Usage; } # -l: handled in main code # -m: questions must match pattern $config::question_filter = eval "sub { local(\$_) = \@_; $::opt_m; }" if defined $::opt_m; die "Bad question filter: $::opt_m\n$@\n" if $@; # -M: answers must match pattern $config::answer_filter = eval "sub { local(\$_) = \@_; $::opt_M; }" if defined $::opt_M; die "Bad answer filter: $::opt_M\n$@\n" if $@; # -n noq: obsolete if (defined $::opt_n) { warn "The `-n noq' flag is no longer supported;\n" ."please press control-D to exit qz instead.\n"; Usage; } # -p: specify question selection program $config'program = $::opt_p if defined $::opt_p; # -r mri: obsolete if (defined $::opt_r) { warn "The `-r mri' flag is no longer supported;\n" ."please override $config'mri in .qzrc instead.\n"; Usage; } # -s: obsolete if ($::opt_s) { warn "The `-s' flag is no longer supported;\n" ."please use `-m hardest' instead.\n"; Usage; } # -v: display version if ($::opt_v) { print "qz version $k'version\n"; exit 0; } # -A: handled in main code # -L: handled in main code # read configuration file { my @files = (); push(@files, "$ENV{'HOME'}/.qzrc") if defined $ENV{'HOME'}; push(@files, '.qzrc'); for my $file (@files) { if (-f $file && -r _) { do $file; last; } } } # make sure -p operand (as possibly overriden by .qzrc) is acceptable unless (defined $config'programs{$config'program}) { print STDERR "Undefined program: `$config'program'\n\n"; Usage; } } # $answer = ReadLine($time, $makelc) - prompt for a line and # update $time, convert to lower case if desired sub ReadLine ($$) { my ($totaltime, $makelc) = @_; my $duration; my $time = 0; local($_); $prompt'resumed = 0; $prompt'waiting = 1; print $prompt'text; $prompt'start = time; while (1) { $_ = ; $prompt'waiting = 0; if ($prompt'resumed) { $prompt'resumed = 0; next unless defined $_; } defined $_ || return $_; $duration = time - $prompt'start - (length $_)/$config'typing_speed; last if $_ eq ''; if (s/^;exit//i) { return undef; } elsif (s/^;//) { print "(", join(',',eval($_)), ")\n";} elsif ($gEnvironment ne 'mac' && s/^!//) { system $_; } elsif ((defined $prompt'lastq) && s/^\+//) { chop; my $note; ($note = ($gQData[$prompt'lastq*$k'fields+$k'fNote].=$_)) =~ s/
|

/\n/g; print "The note for the previous question now reads:\n$note\n"; } else { $time += $duration; last; } $prompt'start = time; $prompt'waiting = 1; print $prompt'text; } $_[0] += $time; s/^[ \t]*//; s/[ \t]+$//; $makelc ? "\L$_" : $_; } # typically invoked from CLI as: ;s sub S () { printf "\nYou answered %d question%s correctly of %d", $gQCorrect, $gQCorrect == 1 ? '' : 's', $prompt'qord; printf " (%.1f%%)", 100 * $gQCorrect/$prompt'qord if $prompt'qord; print ".\n"; printf "You took on average %.1f seconds to answer correctly.\n", $gTotalTime/$gQCorrect if $gQCorrect; print "Congratulations!\n" if $prompt'qord && $gQCorrect/$prompt'qord > 0.9; my $elapsed = time - $gSessionStart; printf "Elapsed time: %d:%02d:%02d\n", int($elapsed/3600), int($elapsed/60) % 60, $elapsed % 60; print "\nCurrent statistics for this question set:\n"; DoListStats; } # SaveData() - save quiz data sub SaveData () { my $qIndex = 0; for my $fileNumber (0..$#gFileNum_Dirty) { if ($gFileNum_Dirty[$fileNumber]) { my $tName = $gFileNum_FileName[$fileNumber]; my $tNewName = $tName; $tNewName =~ s/\.[^.]*$//; $tNewName .= '.new'; EOpenFile *FILE, ">$tNewName"; my $tCount = $gFileNum_QuestionCount[$fileNumber]; my $tFormat = join("\t", ('%s') x $k'fields) . "\n"; while ($tCount-- > 0) { (printf FILE $tFormat, @gQData[$qIndex..$qIndex+$k'fields-1]) || die "Error writing to $tNewName ($!)\nAborting"; $qIndex += $k'fields; } close(FILE) || die "Error closing $tNewName\nAborting"; rename($tNewName, $tName) || die "Error renaming $tNewName to $tName\nAborting"; $gFileNum_Dirty[$fileNumber] = 0; } else { $qIndex += $k'fields*$gFileNum_QuestionCount[$fileNumber]; } } } # SetRating($qNumber, $newRating) - set question's difficulty rating sub SetRating ($$) { my($qNumber, $newRating) = @_; my $qIndex = $k'fields*$qNumber + $k'fRating; my $oldRating = $gQData[$qIndex]; if ($newRating ne $oldRating) { $gQByRating[$oldRating] =~ s/\b$qNumber // || die "Panic (oldRating=$oldRating;g[]=$gQByRating[$oldRating])"; $gQByRating[$newRating] .= "$qNumber "; $gQData[$qIndex] = $newRating; TouchQ $qNumber; my $diff = $newRating - $oldRating; $gTotalRating += $diff; while ($qNumber < $gQCount) { # ELFS: prove that this works $gRatingTree[$qNumber] += $diff; $qNumber |= $qNumber+1; } } } # TouchQ($qNumber) - mark a question as dirty sub TouchQ ($) { my $qNumber = $_[0]; my $fileNumber = 0; if ($qNumber == 0) { $fileNumber = 1; } # exceptional case: no questions else { my $q = 0; while ($q <= $qNumber) { die "Internal error: TouchQ($_[0]), fileNumber=$fileNumber\nAborting" if $fileNumber > $#gFileNum_QuestionCount; $q += $gFileNum_QuestionCount[$fileNumber++]; } } $gFileNum_Dirty[--$fileNumber] = 1; } # Usage() - display usage message and die sub Usage () { print STDERR "Usage:\n". " To see what version of qz this is: qz -v\n". " To see this message again: qz -h\n". " To run a quiz: qz [-p program] [-M answer-pattern] [-m question-pattern] [file.qz...]\n"; print STDERR " (Quiz files default to all the ones in the current directory.)\n"; printf STDERR " %-10s %s\n", 'Program', 'Description'; for my $tP (sort keys %config'program_help) { printf STDERR " %-10s %s\n", $tP, $config'program_help{$tP}; } printf STDERR " To add a question or create a file:\n". " qz -a 'question' 'answer' flags 'note' file.qz\n". " (flags: C=case-insensitive O=word-order-insensitive CO=both)\n". " To add a file full of questions: qz -A [question-file] file.qz\n". " (Line format: question tab answer tab flags tab note)\n". " To delete a question: qz -d 'question' file.qz\n". " To list all questions: qz -l file1.qz [file2.qz...]\n". " To list stats about questions: qz -L file1.qz [file2.qz...]\n"; exit 1; } ## main code sub Main () { srand; ParseCommandLine; if ($::opt_a) { DoAddQuestion @ARGV; } elsif ($::opt_d) { DoDeleteQuestion @ARGV; } elsif ($::opt_A) { DoAddQuestions @ARGV; } elsif ($::opt_l) { DoListQuestions @ARGV; } # To list stats about questions: qz -L file1.qz [file2.qz...]\n". elsif ($::opt_L) { LoadData @ARGV; MungeData; DoListStats; } else { DoRunQuiz @ARGV; } } Main; 0;