processmail/createtable.pl - view

File: [Local Repository] / processmail / createtable.pl
Revision 3.2: download - view: text, annotated - select for diffs - revision graph
Mon Sep 8 17:16:47 2008 UTC (15 years, 9 months ago) by boris
Branches: MAIN
CVS tags: HEAD

Added rating patch from Ivan A Derzhanski <iad58@mail.ru>

1: #!/usr/local/bin/perl 2: #$Id: createtable.pl,v 3.2 2008/09/08 17:16:47 boris Exp $ 3: # 4: # 5: # 6: # Исходные файлы и параметры 7: # 8: 9: use Getopt::Std; 10: 11: $usage = 12: "Usage: createtable.pl [-d] [-s|-m] [-t answers_file] [-o results] \n"; 13: 14: require 'parameters.pl'; 15: require 'subroutines.pl'; 16: 17: die $usage unless getopts('t:o:dsm'); 18: 19: $DEBUG=$opt_d; 20: $SHORT=$opt_s; 21: $MEDIUM=$opt_m; 22: 23: my %teams; 24: my @answers; 25: my @ratings; 26: # 27: # Читаем старые результаты 28: # 29: if ($opt_t) { 30: die "Cannot open $opt_t\n" unless open(INFILE,$opt_t); 31: } else { 32: *INFILE=*STDIN; 33: } 34: 35: readhash(\@answers); 36: close(INFILE); 37: 38: 39: # 40: # Открываем файл для записи 41: # 42: if ($opt_o) { 43: die "Cannot open $opt_o\n" unless open(OUTFILE,">$opt_o"); 44: select OUTFILE; 45: } 46: 47: # Находим максимальный вопрос 48: $MAXQUEST=1; 49: for (my $i=1; $i<=$ROUNDS; $i++) { 50: if ($MAXQUEST<$MAXQUEST[$i]) { 51: $MAXQUEST=$MAXQUEST[$i]; 52: } 53: } 54: 55: 56: # 57: # Таблица подводится отдельно по каждому раунду 58: # 59: my @nopoint_questions; # Здесь будут внезачётные вопросы 60: my @unknowns; # Сюда запомним все '?' 61: for (my $r=1; $r<=$ROUNDS; $r++) { 62: if ($DEBUG) { 63: print STDERR "Раунд $r\n"; 64: } 65: 66: # 67: # Удаляем старые рейтинги (Ivan A Derzhanski <iad58@mail.ru>) 68: # 69: for ($i=1;$i<=$MAXQUEST;$i++) { 70: foreach $answer (keys %{$answers[$i]}) { 71: %{$answers[$i]->{$answer}->{teams}} = (); 72: } 73: } 74: 75: # 76: # Читаем ответы в данном раунде 77: # 78: foreach my $file ( @{$FILES[$r]} ) { 79: open (INFILE, $file); 80: readmail(\%teams); 81: collect_answers(\%teams,\@answers); 82: close (INFILE); 83: } 84: 85: # 86: # Дополняем (добавляем к имеющемуся!) список вопросов, идущих вне зачёта 87: # в данном туре. Для них проставляются плюсы и минусы, но они не входят 88: # в суммарный результат и рейтинг команд. 89: # 90: foreach my $num ( @{$NOCOUNT[$r]} ) 91: { 92: # Если номер не начинается с минуса, то включить его в список 93: # внезачётных, иначе - исключить. Проверяем регэкспом, а не на 94: # "> 0", чтобы можно было использовать и "-0". 95: if ($num =~ /^\d+/) { 96: push @nopoint_questions, $num; 97: } else { 98: @nopoint_questions = grep( $_ != -$num, @nopoint_questions ); 99: } 100: } 101: # И удаляем возможные дубликаты, чтобы всё было красиво. 102: my %seen; 103: @nopoint_questions = grep( !$seen{$_}++, @nopoint_questions ); 104: 105: # 106: # Подсчитываем рейтинги вопросов 107: # 108: rate_questions(\%teams,\@answers,\@ratings,$r); 109: 110: # 111: # Вычисляем число ответов и рейтинги команд 112: # 113: find_scores(\%teams,\@answers,\@ratings,$r,0.01,\@nopoint_questions); 114: 115: # 116: # Ну а теперь печатаем саму таблицу... 117: # 118: # 119: # Печатаем заголовок 120: # 121: # Столько столбцов до пробела в среднем формате ("++-++ +-+-+ -+--+") 122: my $COL=5; 123: 124: print "ЗАЧЁТ $NAME[$r]\n"; 125: if ( @nopoint_questions ) { 126: # Есть незачётные вопросы - печатаем их список. 127: print "Вне зачёта вопрос" . (scalar(@nopoint_questions)>1 ? "ы" : "") 128: . ": " . join(", ", sort {$a<=>$b} @nopoint_questions) . "\n"; 129: } 130: 131: printf "%5s ", "N"; 132: for ($i=$MINQUEST[$r];$i<=$MAXQUEST[$r];$i++) 133: { 134: if ($SHORT) { 135: printf("%1d",$i%10); 136: } elsif ($MEDIUM) { 137: if ($i == int($i/$COL)*$COL || $i==$MAXQUEST[$r]) { 138: printf "%-3d", $i; 139: } else { 140: printf "%s", "."; 141: } 142: } else { 143: printf "%3d",$i; 144: } 145: } 146: printf "%6s","О"; 147: printf "%4s","Р"; 148: printf " КОМАНДА"; 149: print "\n"; 150: 151: # 152: # Печатаем команды построчно 153: # 154: foreach $team (sort 155: { 156: $teams{$b}->{score} <=> $teams{$a}->{score} 157: or 158: $teams{$b}->{rating} <=> $teams{$a}->{rating} 159: } keys %teams 160: ) 161: { 162: printf "%5d ",$teams{$team}->{regnum}; 163: for ($i=$MINQUEST[$r];$i<=$MAXQUEST[$r];$i++) 164: { 165: my $answer = $teams{$team}->{answers}[$i]; 166: my $score = $answers[$i]->{$answer}->{score}; 167: $score = '-' unless $score; 168: 169: # Особо пометим взятые внезачётные вопросы. 170: if ( $score eq '+' && grep($_==$i, @nopoint_questions) ) { 171: $score = 'X'; 172: } 173: 174: # И запомним, если вопрос не взят и не не взят ;-). 175: if ( $score eq '?' ) { 176: my $unk = { 177: question => $i, 178: score => $score, 179: team => $team, 180: regnum => $teams{$team}->{regnum}, 181: round => $r, 182: }; 183: push( @unknowns, $unk ); 184: } 185: 186: # Ну наконец-то! Печатаем. 187: if ($SHORT) { 188: printf "%1s",$score; 189: } elsif ($MEDIUM) { 190: printf "%1s",$score; 191: print " " if ($i == int($i/$COL)*$COL || $i==$MAXQUEST[$r]); 192: } else { 193: printf "%3s", $score; 194: } 195: } 196: printf "%6.2f",$teams{$team}->{score}; 197: printf "%4s",$teams{$team}->{rating}; 198: print " $team"; 199: print "\n"; 200: } 201: 202: # 203: # Печатаем рейтинги вопросов - длинный или короткий варианты. 204: # 205: if ($SHORT || $MEDIUM) { 206: my $nline = 24; # По $nline рейтингов в строке 207: print "\nРейтинг\n"; 208: for ($j=0; $j<$MAXQUEST[$r]/$nline; $j++) { 209: my $max = $j*$nline + $nline; 210: if ($max>$MAXQUEST[$r]) { 211: $max=$MAXQUEST[$r]; 212: } 213: for ($i=$j*$nline+1; $i<=$max; $i++){ 214: printf("%3s",$i); 215: } 216: printf "\n"; 217: for ($i=$j*$nline+1; $i<=$max; $i++){ 218: printf("%3s",$ratings[$i]); 219: } 220: printf "\n"; 221: } 222: } else { 223: # Длинный вариант - под каждым вопросом. 224: printf "%5s ", "Р"; 225: for ($i=$MINQUEST[$r]; $i<=$MAXQUEST[$r]; $i++) 226: { 227: printf "%3s", $ratings[$i]; 228: } 229: print "\n"; 230: } 231: print "\n"; 232: } 233: 234: 235: # Печатаем предупреждение если есть неясные ответы. 236: if ( @unknowns ) { 237: print STDERR "ВНИМАНИЕ! Не всем ответам проставлены '+' и '-':\n"; 238: foreach my $unk ( @unknowns ) { 239: print STDERR "\tКоманда $unk->{team} ($unk->{regnum}), " 240: . "вопрос $unk->{question} ($NAME[$unk->{round}]): " 241: . "$unk->{score}\n"; 242: } 243: } 244: # На всякий случай проверяем на наличие команд с дублирующимися номерами. 245: check_dup_numbers(\%teams);