version 1.3, 2005/01/24 03:16:35
|
version 3.0, 2008/03/23 17:50:50
|
Line 20 sub readhash
|
Line 20 sub readhash
|
if ($answer ne "" && $number >0) |
if ($answer ne "" && $number >0) |
{ |
{ |
$$answers[$number]->{$answer}->{score} = $score; |
$$answers[$number]->{$answer}->{score} = $score; |
|
%{$$answers[$number]->{$answer}->{teams}} = (); |
} |
} |
$answer = ""; |
$answer = ""; |
$number = $1; |
$number = $1; |
Line 130 sub collect_answers
|
Line 131 sub collect_answers
|
my ($teams,$answers) = @_; |
my ($teams,$answers) = @_; |
for ($i=1;$i<=$MAXQUEST;$i++) |
for ($i=1;$i<=$MAXQUEST;$i++) |
{ |
{ |
foreach $answer (keys %{$$answers[$i]}) |
|
{ |
|
@{$$answers[$i]->{$answer}->{teams}} = (); |
|
} |
|
|
|
foreach $team (keys %$teams) |
foreach $team (keys %$teams) |
{ |
{ |
$answer = $$teams{$team}->{answers}[$i]; |
$answer = $$teams{$team}->{answers}[$i]; |
Line 142 sub collect_answers
|
Line 138 sub collect_answers
|
{ |
{ |
next; |
next; |
} |
} |
if (exists $$answers[$i]->{$answer}) |
$$answers[$i]->{$answer}->{teams}->{$team}=1; |
|
if (!exists $$answers[$i]->{$answer}->{score}) |
{ |
{ |
push @{$$answers[$i]->{$answer}->{teams}}, $team; |
|
} |
|
else |
|
{ |
|
my @tmp=($team); |
|
$$answers[$i]->{$answer}->{teams} = \@tmp; |
|
$$answers[$i]->{$answer}->{score} = '?'; |
$$answers[$i]->{$answer}->{score} = '?'; |
} |
} |
} |
} |
foreach $answer (keys %{$$answers[$i]}) |
|
{ |
|
if (scalar @{$$answers[$i]->{$answer}->{teams}} == 0) |
|
{ |
|
delete $$answers[$i]->{$answer}; |
|
} |
|
} |
|
} |
} |
return 1; |
return 1; |
|
|
Line 176 sub dumphash
|
Line 160 sub dumphash
|
if ($$answers[$number]->{$answer}{score} eq $symbol) |
if ($$answers[$number]->{$answer}{score} eq $symbol) |
{ |
{ |
print "\#$number. Frequency: ", |
print "\#$number. Frequency: ", |
scalar @{$answers->[$number]->{$answer}->{teams}}, |
scalar keys %{$answers->[$number]->{$answer}->{teams}}, |
". Score: ", |
". Score: ", |
$$answers[$number]->{$answer}{score},"\n"; |
$$answers[$number]->{$answer}{score},"\n"; |
print $answer; |
print $answer; |
if ($DEBUG) |
if ($DEBUG) |
{ |
{ |
foreach $team (@{$answers->[$number]->{$answer}->{teams}}) |
foreach $team (keys %{$answers->[$number]->{$answer}->{teams}}) |
{ |
{ |
print "Team: ", |
print "Team: ", |
" \"$team\", ",$$teams{$team}->{regnum}, "\n"; |
" \"$team\", ",$$teams{$team}->{regnum}, "\n"; |
Line 203 sub anondump
|
Line 187 sub anondump
|
{ |
{ |
if ($$answers[$number]->{$answer}{score} eq $symbol) |
if ($$answers[$number]->{$answer}{score} eq $symbol) |
{ |
{ |
my $frequency = scalar @{$answers->[$number]->{$answer}->{teams}}; |
my $frequency = scalar keys %{$answers->[$number]->{$answer}->{teams}}; |
my $canon = $answer; |
my $canon = $answer; |
$canon =~ s/^ /$symbol/; |
$canon =~ s/^ /$symbol/; |
if ($frequency >1) |
if ($frequency >1) |
Line 214 sub anondump
|
Line 198 sub anondump
|
print $canon; |
print $canon; |
if ($DEBUG) |
if ($DEBUG) |
{ |
{ |
foreach $team (@{$answers->[$number]->{$answer}->{teams}}) |
foreach $team (keys %{$answers->[$number]->{$answer}->{teams}}) |
{ |
{ |
print STDERR "Team: ", |
print STDERR "Team: ", |
" \"$team\", ",$$teams{$team}->{regnum}, "\n"; |
" \"$team\", ",$$teams{$team}->{regnum}, "\n"; |
Line 231 sub anondump
|
Line 215 sub anondump
|
# |
# |
sub rate_questions |
sub rate_questions |
{ |
{ |
my($teams,$answers,$ratings) = @_; |
my($teams,$answers,$ratings,$round) = @_; |
my $numteams = scalar keys %$teams; |
my $numteams = scalar keys %$teams; |
for ($i=1;$i<=$MAXQUEST;$i++) |
for ($i=$MINQUEST[$round];$i<=$MAXQUEST[$round];$i++) |
{ |
{ |
$$ratings[$i]=$numteams+1; |
$$ratings[$i]=$numteams+1; |
foreach $answer (keys %{$$answers[$i]}) |
foreach $answer (keys %{$$answers[$i]}) |
Line 241 sub rate_questions
|
Line 225 sub rate_questions
|
if ($$answers[$i]->{$answer}{score} eq '+') |
if ($$answers[$i]->{$answer}{score} eq '+') |
{ |
{ |
$$ratings[$i] -= |
$$ratings[$i] -= |
scalar @{$answers->[$i]->{$answer}->{teams}} ; |
scalar keys %{$answers->[$i]->{$answer}->{teams}} ; |
|
if ($DEBUG) { |
|
print STDERR "Частота ответа $answer", |
|
scalar keys %{$answers->[$i]->{$answer}->{teams}}, |
|
"\n"; |
|
} |
} |
} |
} |
} |
} |
} |
if ($DEBUG) |
|
{ |
|
for ($i=1;$i<=$MAXQUEST;$i++) |
|
{ |
|
print STDERR "Вопрос $i, Рейтинг: ", $$ratings[$i], "\n"; |
|
} |
|
} |
|
} |
} |
|
|
# |
# |
# Подсчитываем рейтинги команд |
# Подсчитываем рейтинги команд |
|
# @{$nopoint_questions} - список номеров вопросов, идущих вне зачёта. |
|
# Для них проставляются плясы/минусы, но они не учитываются в подсчёте |
|
# очков и рейтингов команд. |
# |
# |
sub find_scores |
sub find_scores |
{ |
{ |
my ($teams,$answers,$ratings,$factor) = @_; |
my ($teams,$answers,$ratings,$round,$factor,$nopoint_questions) = @_; |
foreach $team (keys %$teams) |
foreach $team (keys %$teams) |
{ |
{ |
if (!defined($factor)) { |
if (!defined($factor)) { |
Line 267 sub find_scores
|
Line 252 sub find_scores
|
} |
} |
$$teams{$team}->{score} *=$factor; |
$$teams{$team}->{score} *=$factor; |
$$teams{$team}->{rating} = 0; |
$$teams{$team}->{rating} = 0; |
for ($i=1;$i<=$MAXQUEST;$i++) |
for ($i=$MINQUEST[$round];$i<=$MAXQUEST[$round];$i++) |
{ |
{ |
my $answer=$$teams{$team}->{answers}[$i]; |
my $answer=$$teams{$team}->{answers}[$i]; |
if ($$answers[$i]->{$answer}{score} eq '+') |
if ($$answers[$i]->{$answer}{score} eq '+') |
{ |
{ |
|
next if ( @{$nopoint_questions} && |
|
grep($_==$i, @{$nopoint_questions}) |
|
); |
$$teams{$team}->{score} += 1; |
$$teams{$team}->{score} += 1; |
$$teams{$team}->{rating} += |
$$teams{$team}->{rating} += |
$$ratings[$i]; |
$$ratings[$i]; |