使用 Perl 按特定字母顺序对字符串进行排序

Question

我正在尝试使用 Perl 按特定字母顺序对名称列表进行排序，以执行一些特殊功能。
排序的工作方式与

sort { $a cmp $b }

相同，但字母顺序不同。
例如，以任意字符顺序排序 "abdrtwsuiopqe987654" ...

我尝试处理

sort { $a myFunction $b }

，但我是 Perl 新手，我不知道如何正确组织

myFunction

来获得我想要的东西。

• 是否有特定的函数（包）提供此功能？
• 您有处理字符串的自定义排序函数的示例吗？
• 你知道

  cmp

  函数是如何（或者在哪个源文件中）用Perl实现的，看看它是如何工作的吗？

Answer 1

以下可能是最快的^[1]：

sub my_compare($$) {
    $_[0] =~ tr{abdrtwsuiopqe987654}{abcdefghijklmnopqrs}r
       cmp
    $_[1] =~ tr{abdrtwsuiopqe987654}{abcdefghijklmnopqrs}r
}

my @sorted = sort my_compare @unsorted;

或者，如果您想要更动态的东西，以下可能是最快的^[2]：

my @syms = split //, 'abdrtwsuiopqe987654';
my @map; $map[ord($syms[$_])] = $_ for 0..$#syms;

sub my_compare($$) {
    (pack 'C*', map $map[ord($_)], unpack 'C*', $_[0])
       cmp
    (pack 'C*', map $map[ord($_)], unpack 'C*', $_[1])
}

my @sorted = sort my_compare @unsorted;

我们可以逐个字符进行比较，但这会远慢。

use List::Util qw( min );

my @syms = split //, 'abdrtwsuiopqe987654';
my @map; $map[ord($syms[$_])] = $_ for 0..$#syms;

sub my_compare($$) {
    my $l0 = length($_[0]);
    my $l1 = length($_[1]);
    for (0..min($l0, $l1)) {
       my $ch0 = $map[ord(substr($_[0], $_, 1))];
       my $ch1 = $map[ord(substr($_[1], $_, 1))];
       return -1 if $ch0 < $ch1;
       return +1 if $ch0 > $ch1;
    }

    return -1 if $l0 < $l1;
    return +1 if $l0 > $l1;
    return 0;
}

my @sorted = sort my_compare @unsorted;

---

1. 从技术上讲，使用 GRT 可以使其更快。

    my @sorted =
       map /\0(.*)/s,
       sort
       map { tr{abdrtwsuiopqe987654}{abcdefghijklmnopqrs}r . "\0" . $_ }
       @unsorted;
   

2. 从技术上讲，使用 GRT 可以使其更快。

    my @sorted =
       map /\0(.*)/s,
       sort
       map { ( pack 'C*', map $map[ord($_)], unpack 'C*', $_ ) . "\0" . $_ }
       @unsorted;
   

---

cmp

由

scmp

运算符实现。

$ perl -MO=Concise,-exec -e'$x cmp $y'
1  <0> enter
2  <;> nextstate(main 1 -e:1) v:{
3  <#> gvsv[*x] s
4  <#> gvsv[*y] s
5  <2> scmp[t3] vK/2
6  <@> leave[1 ref] vKP/REFC

scmp

运算符是由pp_scmp

中的

pp.c函数实现的，当

sv_cmp_flags

不生效时，它实际上只是

sv.c

中

use locale;

的包装。

sv_cmp_flags

使用 C 库函数

memcmp

或支持 UTF-8 的版本（取决于标量的类型）。

Answer 2

use Sort::Key qw(keysort);
my @sorted = keysort { tr/abdrtwsuiopqe987654/abcdefghijklmnopqrs/r } @data;

或者在较旧的 Perls 中不支持

r

 中的 

tr/.../.../r

标志

my @sorted = keysort { my $key = $_;
                       $key =~ tr/abdrtwsuiopqe987654/abcdefghijklmnopqrs/;
                       $key } @data;

您还可以为此类数据创建专门的排序子例程，如下所示：

use Sort::Key::Maker 'my_special_sort',
                     sub { tr/abdrtwsuiopqe987654/abcdefghijklmnopqrs/r },
                     qw(string);

my @sorted = my_special_sort @data;
my @sorted2 = my_special_sort @data2;

Answer 3

在池上的回答中，在“如果你想要更动态的东西”解决方案中，比较函数似乎不正确。以下对我有用：

sub my_compare_orig($$) {
    (pack 'C*', map $map[$_], unpack 'C*', $_[0])
      cmp
    (pack 'C*', map $map[$_], unpack 'C*', $_[1]);
}

我删除了

ord()

调用，因为它是在

@map

被填满时完成的。