Вот один из способов.Пару раз перечитав вашу спецификацию, я думаю, это то, что вы ищете.
Стоит отметить, что, возможно, будет более одного слова с равным высшим баллом.Из вашего списка есть только один победитель, но возможно, что в более длинных списках будет несколько одинаково выигрышных слов.Это решение имеет дело с этим.Также, насколько я понимаю, вы учитываете совпадения букв только в том случае, если они встречаются в одном столбце для каждого слова.Если это так, вот рабочее решение:
use 5.012;
use strict;
use warnings;
use List::Util 'max';
my @words = qw/
BAKER
SALER
BALER
CARER
RUFFR
/;
my @scores;
foreach my $word ( @words ) {
my $score;
foreach my $comp_word ( @words ) {
next if $comp_word eq $word;
foreach my $pos ( 0 .. ( length $word ) - 1 ) {
$score++ if substr( $word, $pos, 1 ) eq substr( $comp_word, $pos, 1);
}
}
push @scores, $score;
}
my $max = max( @scores );
my ( @max_ixs ) = grep { $scores[$_] == $max } 0 .. $#scores;
say "Words with most matches:";
say for @words[@max_ixs];
Это решение подсчитывает, сколько раз в каждом буквенном столбце буквы каждого слова соответствуют другим словам.Например:
Words: Scores: Because:
ABC 1, 2, 1 = 4 A matched once, B matched twice, C matched once.
ABD 1, 2, 1 = 4 A matched once, B matched twice, D matched once.
CBD 0, 2, 1 = 3 C never matched, B matched twice, D matched once.
BAC 0, 0, 1 = 1 B never matched, A never matched, C matched once.
Это дает вам победителей ABC и ABD, каждый из которых имеет по четыре позиционных матча.Т.е. кумулятивное время, в течение которого столбец один, строка один соответствовал столбцу одна строка два, три и четыре и т. Д. Для последующих столбцов.Возможно, его можно будет оптимизировать и перефразировать, чтобы он был короче, но я старался сделать логику довольно легко читаемой.Наслаждайтесь!
ОБНОВЛЕНИЕ / РЕДАКТИРОВАНИЕ Я подумал об этом и понял, что хотя мой существующий метод делает именно то, что запрашивал ваш первоначальный вопрос, он сделал это за O (n ^ 2) время, чтосравнительно медленноНо если мы используем хеш-ключи для букв каждого столбца (по одной букве на ключ) и делаем подсчет того, сколько раз каждая буква появляется в столбце (как значение хеш-элемента), мы могли бы сделать наши суммирования в O (1) время и наш обход списка в O (n * c) времени (где c - количество столбцов, а n - количество слов).Также есть некоторое время установки (создание хэша).Но у нас все еще есть большое улучшение.Вот новая версия каждого метода, а также сравнение каждого из них.
use strict;
use warnings;
use List::Util qw/ max sum /;
use Benchmark qw/ cmpthese /;
my @words = qw/
PARTNERSHIPS
REPRIMANDING
CIVILIZATION
APPRECIATION
CONVERSATION
CIRCUMSTANCE
PURIFICATION
SECLUSIONIST
CONSTRUCTION
DISAPPEARING
TRANSMISSION
APPREHENSIVE
ENCOUNTERING
/;
# Just a test run for each solution.
my( $top, $indexes_ref );
($top, $indexes_ref ) = find_top_matches_force( \@words );
print "Testing force method: $top matches.\n";
print "@words[@$indexes_ref]\n";
( $top, $indexes_ref ) = find_top_matches_hash( \@words );
print "Testing hash method: $top matches.\n";
print "@words[@$indexes_ref]\n";
my $count = 20000;
cmpthese( $count, {
'Hash' => sub{ find_top_matches_hash( \@words ); },
'Force' => sub{ find_top_matches_force( \@words ); },
} );
sub find_top_matches_hash {
my $words = shift;
my @scores;
my $columns;
my $max_col = max( map { length $_ } @{$words} ) - 1;
foreach my $col_idx ( 0 .. $max_col ) {
$columns->[$col_idx]{ substr $_, $col_idx, 1 }++
for @{$words};
}
foreach my $word ( @{$words} ) {
my $score = sum(
map{
$columns->[$_]{ substr $word, $_, 1 } - 1
} 0 .. $max_col
);
push @scores, $score;
}
my $max = max( @scores );
my ( @max_ixs ) = grep { $scores[$_] == $max } 0 .. $#scores;
return( $max, \@max_ixs );
}
sub find_top_matches_force {
my $words = shift;
my @scores;
foreach my $word ( @{$words} ) {
my $score;
foreach my $comp_word ( @{$words} ) {
next if $comp_word eq $word;
foreach my $pos ( 0 .. ( length $word ) - 1 ) {
$score++ if
substr( $word, $pos, 1 ) eq substr( $comp_word, $pos, 1);
}
}
push @scores, $score;
}
my $max = max( @scores );
my ( @max_ixs ) = grep { $scores[$_] == $max } 0 .. $#scores;
return( $max, \@max_ixs );
}
Вывод:
Testing force method: 39 matches.
APPRECIATION
Testing hash method: 39 matches.
APPRECIATION
Rate Force Hash
Force 2358/s -- -74%
Hash 9132/s 287% --
Я понимаю, что ваша оригинальная спецификация изменилась после того, как вы увидели некоторыеиз других предоставленных вариантов, и это в некотором роде природа инноваций, но головоломка все еще была жива в моей памяти.Как видите, мой метод хеширования на 287% быстрее, чем оригинальный метод.Больше веселья за меньшее время!