2012-01-12 4 views
11

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

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

Я split ИНГИ строки вверх в символьные массивы, используя sort подпрограммы Perl, в 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)? И если да, то какой метод более эффективен?

+2

Интересное чтение для сравнения массива: http://stackoverflow.com/questions/1609467/in-perl-is-there-a-built-in-way-to-compare-two-arrays-for-equality – Mat

+3

Вы также можете сравнить длину строки и вернуть false, если длина строк различна, чтобы избежать сортировки строк, которые определенно не являются анаграммами. Для строк с одинаковой длиной сравнение по длине очень быстрое, намного быстрее, чем split-sort-join, поэтому любое поражение производительности будет незначительным. –

+0

Ну, вы можете улучшить производительность, избавившись от функции сравнения - вам это не нужно: 'join '', sort split (//, $ s1)'. – derobert

ответ

1

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

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

1

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

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

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

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

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

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

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

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

2

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

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

но тесты не несут это.

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

извините, но я не знаком с этим бенчмаркингом. как вы дали эти результаты? – ardnew

+0

@ardnew: Похоже на стандартный вывод из модуля [Benchmark] (http://search.cpan.org/perldoc?Benchmark). –

5

Ну, я нашел способ, который более чем в 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.

+0

, хотя это решение несколько более строгое в том, где его можно применять, я восхищаюсь увеличением производительности – ardnew

+0

, есть ли какая-то конкретная причина, по которой вы ограничиваете решение в нижнем регистре ASCII? если ваш буфер был достаточно большим для хранения всех значений ASCII, вам не понадобилось бы if-условие или смещение векторных индексов на 'a' – ardnew

+0

@ardnew: правда, было бы легко расширить до Latin1 (там было бы я подозреваю, что это тривиальная потеря производительности. Расширение до символов Perl (например, Unicode) было бы очень нетривиальным. Конечно, решение Perl неправильно обрабатывает Unicode (оно не нормализуется), поэтому, я думаю, это нормально ... Будет проверять и обновлять ответ. – derobert

Смежные вопросы