--- processmail/subroutines.pl 2005/01/24 03:14:49 1.2 +++ processmail/subroutines.pl 2008/03/23 17:50:50 3.0 @@ -1,7 +1,7 @@ # В этот файл собраны процедуры, общие для всей системы # работы с ответами. # -#$Id: subroutines.pl,v 1.2 2005/01/24 03:14:49 boris Exp $ +#$Id: subroutines.pl,v 3.0 2008/03/23 17:50:50 boris Exp $ # sub readhash { @@ -20,6 +20,7 @@ sub readhash if ($answer ne "" && $number >0) { $$answers[$number]->{$answer}->{score} = $score; + %{$$answers[$number]->{$answer}->{teams}} = (); } $answer = ""; $number = $1; @@ -130,11 +131,6 @@ sub collect_answers my ($teams,$answers) = @_; for ($i=1;$i<=$MAXQUEST;$i++) { - foreach $answer (keys %{$$answers[$i]}) - { - @{$$answers[$i]->{$answer}->{teams}} = (); - } - foreach $team (keys %$teams) { $answer = $$teams{$team}->{answers}[$i]; @@ -142,24 +138,12 @@ sub collect_answers { 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} = '?'; } } - foreach $answer (keys %{$$answers[$i]}) - { - if (scalar @{$$answers[$i]->{$answer}->{teams}} == 0) - { - delete $$answers[$i]->{$answer}; - } - } } return 1; @@ -176,13 +160,13 @@ sub dumphash if ($$answers[$number]->{$answer}{score} eq $symbol) { print "\#$number. Frequency: ", - scalar @{$answers->[$number]->{$answer}->{teams}}, + scalar keys %{$answers->[$number]->{$answer}->{teams}}, ". Score: ", $$answers[$number]->{$answer}{score},"\n"; print $answer; if ($DEBUG) { - foreach $team (@{$answers->[$number]->{$answer}->{teams}}) + foreach $team (keys %{$answers->[$number]->{$answer}->{teams}}) { print "Team: ", " \"$team\", ",$$teams{$team}->{regnum}, "\n"; @@ -203,7 +187,7 @@ sub anondump { 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; $canon =~ s/^ /$symbol/; if ($frequency >1) @@ -214,7 +198,7 @@ sub anondump print $canon; if ($DEBUG) { - foreach $team (@{$answers->[$number]->{$answer}->{teams}}) + foreach $team (keys %{$answers->[$number]->{$answer}->{teams}}) { print STDERR "Team: ", " \"$team\", ",$$teams{$team}->{regnum}, "\n"; @@ -231,9 +215,9 @@ sub anondump # sub rate_questions { - my($teams,$answers,$ratings) = @_; + my($teams,$answers,$ratings,$round) = @_; my $numteams = scalar keys %$teams; - for ($i=1;$i<=$MAXQUEST;$i++) + for ($i=$MINQUEST[$round];$i<=$MAXQUEST[$round];$i++) { $$ratings[$i]=$numteams+1; foreach $answer (keys %{$$answers[$i]}) @@ -241,25 +225,26 @@ sub rate_questions if ($$answers[$i]->{$answer}{score} eq '+') { $$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 { - my ($teams,$answers,$ratings,$factor) = @_; + my ($teams,$answers,$ratings,$round,$factor,$nopoint_questions) = @_; foreach $team (keys %$teams) { if (!defined($factor)) { @@ -267,11 +252,14 @@ sub find_scores } $$teams{$team}->{score} *=$factor; $$teams{$team}->{rating} = 0; - for ($i=1;$i<=$MAXQUEST;$i++) + for ($i=$MINQUEST[$round];$i<=$MAXQUEST[$round];$i++) { my $answer=$$teams{$team}->{answers}[$i]; if ($$answers[$i]->{$answer}{score} eq '+') { + next if ( @{$nopoint_questions} && + grep($_==$i, @{$nopoint_questions}) + ); $$teams{$team}->{score} += 1; $$teams{$team}->{rating} += $$ratings[$i];