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