--- processmail/subroutines.pl	2002/02/04 17:18:33	1.1
+++ processmail/subroutines.pl	2008/03/24 16:01:47	3.1
@@ -1,7 +1,7 @@
 # В этот файл собраны процедуры, общие для всей системы
 # работы с ответами.
 #
-#$Id: subroutines.pl,v 1.1 2002/02/04 17:18:33 boris Exp $
+#$Id: subroutines.pl,v 3.1 2008/03/24 16:01:47 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;
@@ -65,9 +66,11 @@ sub readmail
 	    {
 		my @teamanswers = ();
 		my %teamhash = ('answers' => \@teamanswers, 
-				'regnum' => $2);
+				'regnum' => $2,
+				'numletters'=>0);
 		$$table{$team} = \%teamhash;
 	    }
+	    $$table{$team}->{'numletters'}++;
 	    if ($$table{$team}->{regnum} != $2)
 	    {
 		print STDERR "Warning: Team $team uses registration nos. ",
@@ -128,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];
@@ -140,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;
 
@@ -174,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";
@@ -201,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)
@@ -212,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";
@@ -229,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]})
@@ -239,34 +225,41 @@ 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) = @_;
+    my ($teams,$answers,$ratings,$round,$factor,$nopoint_questions) = @_;
     foreach $team (keys %$teams)
     {
-	$$teams{$team}->{score} = 0;
+	if (!defined($factor)) {
+	    $factor=1;
+	}
+	$$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];
@@ -283,18 +276,38 @@ sub find_scores
 }
 
 
-1;
-
-
-
-
-
-
-
-
-
+#
+# Проверяем на наличие дублирующихся номеров у разных команд.
+#
+sub check_dup_numbers
+{
+    my ($teams) = @_;
 
+    my %seen;
 
+    # Имена команд, номера которых встречаются >1 раза.
+    # Массив uniq_compr_names содержит по одному имени на каждый повторяющийся
+    # номер (чуть позже мы найдём все имена, соответствующие каждому из 
+    # этих номеров).
+    # '+0' - чтобы номера обрабатывались как числа (072 == 72).
+    my @uniq_compr_names =
+       grep( $seen{$teams->{$_}->{regnum}+0}++ > 1, keys %$teams );
+
+    # А теперь извлекаем номера из полученного списка.
+    my @dup_numbers = map {$teams->{$_}->{regnum}} @uniq_compr_names;
+    @dup_numbers = sort @dup_numbers;
+
+    # И печатаем предупреждение.
+    if ( @dup_numbers ) {
+	print STDERR "\nВНИМАНИЕ!  Одинаковые номера у нескольких команд:\n";
+	foreach my $num ( @dup_numbers ) {
+	    my @dup_names = grep($teams->{$_}->{regnum} == $num, keys %$teams);
+	    print STDERR "\tНомер $num: " .  join(", ", @dup_names) . "\n";
+        }
+	print STDERR "\n";
+    }
+}
 
 
 
+1;