Perl: Sắp xếp các ký tự trong một chuỗi

Question

Tôi có hai chuỗi và tôi muốn kiểm tra xem chúng có phải là đảo chữ cái của nhau hay không.

Để kiểm tra xem chuỗi A là một đảo chữ cái của chuỗi B, các ký tự của A và B đều được sắp xếp. Nếu các chuỗi được sắp xếp kết quả khớp chính xác, chuỗi A và chuỗi B là đảo chữ cái của nhau.

Tôi split ing các chuỗi thành mảng ký tự, sử dụng sort thói quen của Perl, join ing các nhân vật lại với nhau, và thử nghiệm cho sự bình đẳng chuỗi với eq:

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

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

Có cách nào để tránh việc phải chuyển đổi giữa các loại vô hướng và mảng (dựa trên join và split)? Và nếu có, phương pháp nào hiệu quả hơn?

Answer 1

Nếu cả hai chuỗi đều biến đổi, tôi không nghĩ bạn có thể làm tốt hơn nhiều. Một cách khác là xây dựng một băm để ánh xạ các ký tự cho số lượng của chúng, và sau đó so sánh các băm có cùng khóa và giá trị. Tôi tin rằng đây là O (n) thay vì O (n log n) cho cách tiếp cận của bạn, nhưng nó có lẽ sẽ có hiệu suất thực tế tồi tệ hơn ngoại trừ các chuỗi rất dài.

Nếu bạn muốn so sánh các chuỗi biến với chuỗi tham chiếu cố định, thì có lẽ cách tiếp cận dựa trên hàm băm có thể trả cổ tức sớm hơn, vì bạn chỉ cần băm tham chiếu một lần.

Answer 2

Có cách nào để tránh phải chuyển đổi giữa các loại vô hướng và mảng (dựa trên join và split)? Và nếu có, phương pháp nào hiệu quả hơn?

Vì bạn hỏi đây là hai câu hỏi riêng biệt, tôi sẽ trả lời cả hai.

Có, có nhiều cách để thực hiện việc này mà không cần tạo mảng @ hoặc % băm hoặc điều gì và tôi sẽ phác thảo một vài; nhưng cách của bạn hiệu quả hơn bất kỳ cách nào trong số này.

Một cách là để điều trị một chuỗi như một mảng kí tự bằng cách sử dụng the substr function ($c = substr $s, 4, 1 bộ $c đến yếu tố thứ năm của $s, và substr($s, 4, 1) = $c đặt yếu tố thứ năm của $s-$c), và thực hiện bất kỳ thuật toán phân loại điển hình trên nó .

Ngoài ra, tôi chắc chắn bạn có thể thực hiện phân loại bong bóng bằng cách sử dụng chỉ thay thế regex với /e.

Cuối cùng, nếu bạn sẵn sàng bỏ qua những phương pháp loại-then-so sánh, bạn có thể viết:

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

Nhưng, một lần nữa, split -then- join là hiệu quả hơn bất kỳ những .

Answer 3

Tôi nghĩ sử dụng các trận đấu thông minh để so sánh các mảng mà không cần phải tái tạo chuỗi sẽ phải cơ hội để làm tốt hơn phương pháp của OP

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

nhưng các tiêu chuẩn không chịu mà ra.

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

Answer 4

Vâng, tôi đã tìm thấy cách nhanh hơn 30 lần — mặc dù, cho là gian lận của nó. Tôi đã bao gồm mã Benchmark.pm để chuẩn nó, vì bạn dường như không quen thuộc với nó.

Điểm chuẩn là:

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

Và mã. Sau khi dòng thứ ba, tôi nghĩ bạn sẽ hiểu tại sao gian lận cho là của nó:

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)); 
} 

Tất nhiên, gian lận của nó bởi vì nó không được viết bằng Perl-nó trong C. Ngoài ra, nó có những hạn chế của phiên bản Perl không (chỉ hoạt động với các ký tự ASCII chữ thường là quan trọng nhất — nó chỉ bỏ qua mọi thứ khác). Nhưng nếu bạn thực sự cần tốc độ, bạn có thể sử dụng gian lận như thế này.

chỉnh sửa:

Mở rộng cho tất cả Latin1 (ký tự 8 bit thật, thực sự). Ngoài ra, tôi thấy rằng trình biên dịch quản lý để tối ưu hóa một vòng lặp đơn giản hơn (không có điểm số học) tốt hơn, và dễ đọc hơn, vì vậy ... Benchmark cho tôi biết rằng phiên bản chỉ ASCII chỉ là khoảng 10% nhanh hơn:

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)); 
} 

Lưu ý rằng lợi thế của phiên bản C phát triển khi chuỗi dài hơn — được mong đợi, vì Θ (n) trái với phiên bản Perl O (n · logn). Ngoài ra hình phạt cho toàn Latin1 giảm, có nghĩa là hình phạt có lẽ là memcmp.