Perl: сортировка символов внутри строки

У меня две строки, и я хотел бы проверить, являются ли они анаграммами друг друга.

Чтобы проверить, является ли строка A анаграммой строки B, символы A и B сортируются. Если результирующие отсортированные строки точно совпадают, строка A и строка B являются анаграммами друг друга.

Я split вставляя строки в массивы символов, используя процедуру Perl sort, join объединяя символы вместе и проверяя равенство строки с помощью eq:

sub anagram
{
  my ($s1, $s2) = @_;

  return (join '', sort { $a cmp $b } split(//, $s1)) eq
         (join '', sort { $a cmp $b } split(//, $s2));
}

Есть ли способ избежать преобразования между скалярными и массивными типами (полагаясь на join и split)? И если да, то какой метод более эффективен?

Ответ 1

Если обе строки являются переменными, я не думаю, что вы можете сделать намного лучше. Один из вариантов заключается в создании хэша, который отображает символы в их подсчеты, а затем сравнивает, что хеши имеют одинаковые ключи и значения. Я полагаю, что для вашего подхода это O (n) вместо O (n log n), но, вероятно, он будет иметь худшую фактическую производительность, за исключением очень длинных строк.

Если вы хотите сравнить переменные строки с фиксированной ссылочной строкой, то, возможно, хэш-подход может выплачивать дивиденды раньше, так как вам нужно только хэшировать ссылку один раз.

Ответ 2

Ну, я нашел способ, который в 30 раз быстрее, хотя, возможно, его обман. Я включил код Benchmark.pm, чтобы сравнить его, поскольку вы, по-видимому, не знакомы с ним.

Тест:

           Rate  Join Cheat
Join    83294/s    --  -97%
Cheat 2580687/s 2998%    --

И код. После третьей строки, я думаю, вы поймете, почему ее возможно обманывают:

use v5.14;
use Benchmark qw(cmpthese);
use Inline 'C';

sub an_join {
    my ($s1, $s2) = @_;
    return (join '', sort split(//, $s1)) eq
        (join '', sort split(//, $s2));
}

use constant {
    STR1 => 'abcdefghijklm',
    STR2 => 'abcdefghijkmm',
    STR3 => 'abcdefghijkml',
};

cmpthese(
    0,
    {
        'Join'  => 'an_join(STR1, STR2);  an_join(STR1, STR3)',
        'Cheat' => 'an_cheat(STR1, STR2); an_cheat(STR1, STR3)',
    });

__END__
__C__

int an_cheat(const char *a, const char *b) {
    unsigned char vec_a[26], vec_b[26];
    const char *p, *end;

    memset(vec_a, 0, sizeof(vec_a));
    memset(vec_b, 0, sizeof(vec_b));

    end = a+strlen(a);
    for (p = a; p < end; ++p)
        if (*p >= 'a' && *p <= 'z')
            ++vec_a[(*p)-'a'];
    end = b+strlen(b);
    for (p = b; p < end; ++p)
        if (*p >= 'a' && *p <= 'z')
            ++vec_b[(*p)-'a'];

    return 0 == memcmp(vec_a, vec_b, sizeof(vec_a));
}

Конечно, его обман, потому что он не написан на Perl-его в C. Кроме того, он имеет ограничения, которые версия Perl не имеет (работает только с строчными ASCII-символами, которые являются самыми значительными, - это просто игнорирует все остальное). Но если вам действительно нужна скорость, вы можете использовать обман вроде этого.

изменить:

Расширение на все Latin1 (ну, сырые 8-битные символы, действительно). Кроме того, я обнаружил, что компилятору удалось оптимизировать более простой цикл (без точечной арифметики), и его легче читать, поэтому... Benchmark сообщает мне, что версия с нижним регистром ASCII примерно на 10% быстрее:

int an_cheat_l1b(const char *a, const char *b) {
    unsigned char vec_a[UCHAR_MAX], vec_b[UCHAR_MAX];
    size_t len, i;

    memset(vec_a, 0, sizeof(vec_a));
    memset(vec_b, 0, sizeof(vec_b));

    len = strlen(a);
    for (i = 0; i < len; ++i)
        ++vec_a[((const unsigned char *)(a))[i]];
    len = strlen(b);
    for (i = 0; i < len; ++i)
        ++vec_b[((const unsigned char *)(b))[i]];

    return 0 == memcmp(vec_a, vec_b, sizeof(vec_a));
}

Обратите внимание, что преимущество версии C возрастает по мере того, как строка становится длиннее, что ожидается, так как ее Θ (n) в отличие от версий Perl O (n · logn). Также уменьшается штраф за полный латинский 1, что означает, что штраф, вероятно, является memcmp.

Ответ 3

Я думал, что использование умных совпадений для сравнения массивов без необходимости воссоздавать строку должно было бы опередить метод OP

sub anagram_smatch {
    return [sort split//,$_[0]] ~~ [sort split//,$_[1]];
}

но контрольные показатели не выдерживают этого.

         Rate smatch   join
smatch 1.73/s     --   -54%
join   3.72/s   116%     --

Ответ 4

Есть ли способ избежать преобразования между скалярными и массивными типами (полагаясь на join и split)? И если да, то какой метод более эффективен?

Поскольку вы задаете их как два отдельных вопроса, я отвечу на оба.

Да, есть способы сделать это без создания массива @ или хэша % или еще чего-то еще, и я опишу несколько; но ваш способ более эффективен, чем любой из них.

Один из способов - обработать строку как массив символов, используя функцию substr ($c = substr $s, 4, 1 устанавливает $c в пятый элемент $s и substr($s, 4, 1) = $c устанавливает пятый элемент $s в $c) и реализует на нем любой типичный алгоритм сортировки.

В качестве альтернативы, я уверен, что вы можете реализовать сортировку пузырьков с помощью только регулярных выражений с помощью /e.

Наконец, если вы готовы отказаться от подхода sort-then-compare, вы можете написать:

sub anagram
{
    my ($s1, $s2) = @_;
    while($s1 =~ m/\G(.)/s)
      { $s2 =~ s/\Q$1// or return ''; }
    return $s2 eq '';
}

Но опять же, split -then- join более эффективен, чем любой из них.