![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to subroutines.pl CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Local Repository] / processmail|
Return to subroutines.pl CVS log | Up to [Local Repository] / processmail |
1.1 boris 1: # В этот файл собраны процедуры, общие для всей системы
2: # работы с ответами.
3: #
1.5 ! boris 4: #$Id: subroutines.pl,v 1.4 2005/02/15 19:27:51 boris Exp $
1.1 boris 5: #
6: sub readhash
7: {
8: my ($answers) = @_;
9: my $answer = "";
10: my $score = "";
11: my $number = -1;
12: while (<INFILE>)
13: {
14: if (/^\s*\#(\d+).*Score:\s*([+-\?])/) # Нашли новый ответ
15: {
16: if ($DEBUG)
17: {
18: print STDERR "\#$number. Score: $score\n",$answer;
19: }
20: if ($answer ne "" && $number >0)
21: {
22: $$answers[$number]->{$answer}->{score} = $score;
1.4 boris 23: %{$$answers[$number]->{$answer}->{teams}} = ();
1.1 boris 24: }
25: $answer = "";
26: $number = $1;
27: $score = $2;
28: next;
29: }
30: if (/^Team:/)
31: {
32: next;
33: }
34: if (/^\s*\*\*\*\s*$/)
35: {
36: if ($answer ne "" && $number >0)
37: {
38: $$answers[$number]->{$answer}->{score} = $score;
39: }
40: last;
41: }
42: $answer .= &canonize_answer;
43: }
44: return 1;
45: }
46:
47: #
48: # Читаем файл с письмами команд
49: #
50: sub readmail
51: {
52: my ($table) = @_;
53: $team="";
54: $number=-1;
55: while (<INFILE>)
56: {
57: if (/^\s*\*\*\*\s*"(.+)"\s*[,.]*\s*(\d+)*/) # Нашли новую команду
58: {
59: if ($DEBUG)
60: {
61: print STDERR "Команда: $1, рег. номер: $2\n";
62: }
63: $team = $1;
64: $number = -1;
65: if (!exists($$table{$team})) # Новая команда...
66: {
67: my @teamanswers = ();
68: my %teamhash = ('answers' => \@teamanswers,
1.2 boris 69: 'regnum' => $2,
70: 'numletters'=>0);
1.1 boris 71: $$table{$team} = \%teamhash;
72: }
1.2 boris 73: $$table{$team}->{'numletters'}++;
1.1 boris 74: if ($$table{$team}->{regnum} != $2)
75: {
76: print STDERR "Warning: Team $team uses registration nos. ",
77: $$table{$team}->{regnum}, " and $2!\n";
78: }
79: next;
80: }
81: if (s/^\s*\#(\d+)\.*// && $team ne "")
82: {
83: if ($DEBUG)
84: {
85: print STDERR "Ответ $1\n";
86: print STDERR;
87: }
88: $number = $1;
89: $$table{$team}->{answers}[$number] = &canonize_answer;
90: next;
91: }
92: if (/^\*\*\*/) # Команда кончилась
93: {
94: $team="";
95: $number=-1;
96: }
97: if ($team ne "" && $number >0)
98: {
99: if ($DEBUG)
100: {
101: print STDERR;
102: }
103: $$table{$team}->{answers}[$number] .= &canonize_answer;
104: }
105: }
106: return 1;
107: }
108:
109: #
110: # Приводим ответ к канонической форме: два пробела в начале,
111: # ни одного в конце
112: #
113: sub canonize_answer
114: {
115: s/^\s*(.*)\s*$/ $1/;
116: if (/^\s*$/)
117: {
118: return "";
119: }
120: else
121: {
122: return $_."\n";
123: }
124: }
125:
126: #
127: # Заполняем поля %answers
128: #
129: sub collect_answers
130: {
131: my ($teams,$answers) = @_;
132: for ($i=1;$i<=$MAXQUEST;$i++)
133: {
134: foreach $team (keys %$teams)
135: {
136: $answer = $$teams{$team}->{answers}[$i];
137: if ($answer eq "")
138: {
139: next;
140: }
1.4 boris 141: $$answers[$i]->{$answer}->{teams}->{$team}=1;
142: if (!exists $$answers[$i]->{$answer}->{score})
1.1 boris 143: {
144: $$answers[$i]->{$answer}->{score} = '?';
145: }
146: }
147: }
148: return 1;
149:
150: }
151:
152: #
153: # Сбрасываем ответы на вопрос $number с оценкой $symbol
154: #
155: sub dumphash
156: {
157: my ($teams,$answers,$number,$symbol) = @_;
158: foreach $answer (keys %{$answers->[$number]})
159: {
160: if ($$answers[$number]->{$answer}{score} eq $symbol)
161: {
162: print "\#$number. Frequency: ",
1.4 boris 163: scalar keys %{$answers->[$number]->{$answer}->{teams}},
1.1 boris 164: ". Score: ",
165: $$answers[$number]->{$answer}{score},"\n";
166: print $answer;
167: if ($DEBUG)
168: {
1.4 boris 169: foreach $team (keys %{$answers->[$number]->{$answer}->{teams}})
1.1 boris 170: {
171: print "Team: ",
172: " \"$team\", ",$$teams{$team}->{regnum}, "\n";
173: }
174: }
175: }
176: }
177: return 1;
178: }
179: #
180: # Сбрасываем ответы на вопрос $number с оценкой $symbol
181: # в формате, пригодном для собрания сочинений
182: #
183: sub anondump
184: {
185: my ($teams,$answers,$number,$symbol) = @_;
186: foreach $answer (keys %{$answers->[$number]})
187: {
188: if ($$answers[$number]->{$answer}{score} eq $symbol)
189: {
1.4 boris 190: my $frequency = scalar keys %{$answers->[$number]->{$answer}->{teams}};
1.1 boris 191: my $canon = $answer;
192: $canon =~ s/^ /$symbol/;
193: if ($frequency >1)
194: {
195: chomp $canon;
196: $canon .= " [$frequency]\n";
197: }
198: print $canon;
199: if ($DEBUG)
200: {
1.4 boris 201: foreach $team (keys %{$answers->[$number]->{$answer}->{teams}})
1.1 boris 202: {
203: print STDERR "Team: ",
204: " \"$team\", ",$$teams{$team}->{regnum}, "\n";
205: }
206: }
207: }
208: }
209: return 1;
210: }
211:
212: #
213: # Подсчитываем рейтинги вопросов. Рейтинг вопроса есть
214: # 1+количество команд, которые на него НЕ ответили
215: #
216: sub rate_questions
217: {
1.5 ! boris 218: my($teams,$answers,$ratings,$round) = @_;
1.1 boris 219: my $numteams = scalar keys %$teams;
1.5 ! boris 220: for ($i=$MINQUEST[$round];$i<=$MAXQUEST[$round];$i++)
1.1 boris 221: {
222: $$ratings[$i]=$numteams+1;
223: foreach $answer (keys %{$$answers[$i]})
224: {
225: if ($$answers[$i]->{$answer}{score} eq '+')
226: {
227: $$ratings[$i] -=
1.5 ! boris 228: scalar keys %{$answers->[$i]->{$answer}->{teams}} ;
! 229: if ($DEBUG) {
! 230: print STDERR "Частота ответа $answer",
! 231: scalar keys %{$answers->[$i]->{$answer}->{teams}},
! 232: "\n";
! 233: }
1.1 boris 234: }
235: }
236: }
237: }
238:
239: #
240: # Подсчитываем рейтинги команд
241: #
242: sub find_scores
243: {
1.5 ! boris 244: my ($teams,$answers,$ratings,$round,$factor) = @_;
1.1 boris 245: foreach $team (keys %$teams)
246: {
1.2 boris 247: if (!defined($factor)) {
248: $factor=1;
249: }
250: $$teams{$team}->{score} *=$factor;
1.1 boris 251: $$teams{$team}->{rating} = 0;
1.5 ! boris 252: for ($i=$MINQUEST[$round];$i<=$MAXQUEST[$round];$i++)
1.1 boris 253: {
254: my $answer=$$teams{$team}->{answers}[$i];
255: if ($$answers[$i]->{$answer}{score} eq '+')
256: {
257: $$teams{$team}->{score} += 1;
258: $$teams{$team}->{rating} +=
259: $$ratings[$i];
260: }
261: }
262: if ($DEBUG)
263: {
264: print STDERR "$team: Score ",
265: $$teams{$team}->{score},
266: ", Rating ",
267: $$teams{$team}->{rating},"\n";
268: }
269: }
270: }
271:
272:
273: 1;
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287: