Генератор тестовых данных
#!/usr/bin/env perl
use strict;
use warnings;
foreach my $i (1..5)
{
my $file = "words$i.txt";
open my $fh, '>', $file or die "Failed to open $file for writing ($!)";
foreach my $w (qw (we are the people in charge and what we say goes))
{
my $suffix = substr('*#$&', rand(4), 1);
print $fh "$w$suffix\n";
}
}
Код большинства голосов
#!/usr/bin/env perl
use strict;
use warnings;
my @files = ( "words1.txt", "words2.txt", "words3.txt",
"words4.txt", "words5.txt"
);
my @fh;
{
my $n = 0;
foreach my $file (@files)
{
open my $f, '<', $file or die "Can't open $file for reading ($!)";
$fh[$n++] = $f;
}
}
while (my $r = process_line(@fh))
{
print "$r\n";
}
sub process_line
{
my(@fhlist) = @_;
my %words = ();
foreach my $fh (@fhlist)
{
my $line = <$fh>;
return unless defined $line;
chomp $line;
$words{$line}++;
}
my $combo = '';
foreach my $word (keys %words)
{
return $word if ($words{$word} > 2);
$combo .= $word if ($words{$word} == 2);
}
$combo =~ s/(\W)\w+(\W)/$1$2/;
return $combo;
}
Пример данных и результатов
$ perl datagenerator.pl
$ perl majorityvoter.pl > results.txt
$ paste words?.txt results.txt
we* we$ we& we# we# we#
are* are# are# are* are$ are*#
the* the& the# the# the& the&#
people& people& people$ people# people# people&#
in# in* in$ in* in* in*
charge* charge# charge& charge* charge# charge#*
and$ and* and$ and& and$ and$
what& what& what$ what& what# what&
we# we* we* we& we* we*
say$ say& say$ say$ say$ say$
goes$ goes& goes# goes# goes# goes#
$
Кажется, это правильно для тестовых данных в сгенерированных файлах.
Пересмотренные требования - пример вывода
«Пересмотренные требования» заменили маркеры «* # $ &» после слов на вкладку и одну из букв «ABCD». После некоторых быстрых переговоров вопрос возвращается к своей первоначальной форме. Этот вывод взят из соответственно адаптированной версии ответа выше - 3 строки кода изменены, 2 в генераторе данных, 1 в мажоритарном избирателе. Эти изменения не показаны - они тривиальны.
we C we D we C we C we D we C
are C are D are C are B are A are C
the B the D the A the A the D the A|D
people D people B people A people B people D people B|D
in D in B in C in B in D in D|B
charge C charge D charge D charge D charge A charge D
and A and B and C and C and B and B|C
what B what B what B what C what C what B
we D we B we D we B we A we B|D
say D say D say B say D say D say D
goes A goes C goes A goes C goes A goes A
Исправлен тестовый генератор - для настраиваемого количества файлов
Теперь, когда автор разработал способ обработки пересмотренного сценария, это код генератора данных, который я использовал - с 5 тегами (A-E). Очевидно, что для настройки количества тегов в командной строке не потребовалось бы огромных усилий.
#!/usr/bin/env perl
use strict;
use warnings;
my $fmax = scalar(@ARGV) > 0 ? $ARGV[0] : 5;
my $tags = 'ABCDE';
my $ntags = length($tags);
my $fmt = sprintf "words$fmax-%%0%0dd.txt", length($fmax);
foreach my $fnum (1..$fmax)
{
my $file = sprintf $fmt, $fnum;
open my $fh, '>', $file or die "Failed to open $file for writing ($!)";
foreach my $w (qw(We Are The People In Charge And What We Say Goes))
{
my $suffix = substr($tags, rand($ntags), 1);
print $fh "$w\t$suffix\n";
}
}
Пересмотренный код большинства голосов - для произвольного количества файлов
Этот код работает с произвольным количеством файлов. Как отмечено в одном из (многих) комментариев, он не проверяет, является ли слово одинаковым в каждом файле, как того требует вопрос; вы можете получить необычные результаты, если слова не совпадают.
#!/usr/bin/env perl
use strict;
use warnings;
my @files = scalar @ARGV > 0 ? @ARGV :
( "words1.txt", "words2.txt", "words3.txt",
"words4.txt", "words5.txt"
);
my $voters = scalar(@files);
my @fh;
{
my $n = 0;
foreach my $file (@files)
{
open my $f, '<', $file or die "Can't open $file for reading ($!)";
$fh[$n++] = $f;
}
}
while (my $r = process_line(@fh))
{
print "$r\n";
}
sub process_line
{
my(@fhlist) = @_;
my %words = ();
foreach my $fh (@fhlist)
{
my $line = <$fh>;
return unless defined $line;
chomp $line;
$words{$line}++;
}
return winner(%words);
}
# Get tag X from entry "word\tX".
sub get_tag_from_word
{
my($word) = @_;
return (split /\s/, $word)[1];
}
sub winner
{
my(%words) = @_;
my $maxscore = 0;
my $winscore = ($voters / 2) + 1;
my $winner = '';
my $taglist = '';
foreach my $word (sort keys %words)
{
return "$word\t$words{$word}" if ($words{$word} >= $winscore);
if ($words{$word} > $maxscore)
{
$winner = $word;
$winner =~ s/\t.//;
$taglist = get_tag_from_word($word);
$maxscore = $words{$word};
}
elsif ($words{$word} == $maxscore)
{
my $newtag = get_tag_from_word($word);
$taglist .= "|$newtag";
}
}
return "$winner\t$taglist\t$maxscore";
}
Один пример прогона
После значительных экспериментов с представлением данных один конкретный набор данных, который я сгенерировал, дал результат:
We A|B|C|D|E 2 B C C E D A D A E B
Are D 4 C D B A D B D D B E
The A 5 D A B B A A B E A A
People D 4 E D C D B E D D B C
In D 3 E C D D D B C A A B
Charge A|E 3 E E D A D A B A E B
And E 3 C E D D C A B E B E
What A 5 B C C A A A B A D A
We A 4 C A A E A E C D A E
Say A|D 4 A C A A D E D A D D
Goes A 3 D B A C C A A E E B
Первый столбец - это слово; вторая - выигрышная метка или метки; третий (числовой) столбец - максимальная оценка; остальные 10 столбцов являются тегами из 10 файлов данных. Как видите, в первом ряду по два «Мы А», «Мы Б»,… «Мы Е». Я также сгенерировал (но не сохранил) один набор результатов, где максимальный балл был равен 7. При достаточном повторении можно найти такие варианты.