processmail/createtable.pl - view

File: [Local Repository] / processmail / createtable.pl
Revision 3.4: download - view: text, annotated - select for diffs - revision graph
Wed Oct 30 19:28:30 2013 UTC (10 years, 8 months ago) by boris
Branches: MAIN
CVS tags: HEAD

New changes from Lev

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