在 Perl 6 中使用修改后的字母表进行排序
Sorting with modified alphabet in Perl 6
我必须使用不同的 'modified' 字母对字符串列表进行排序。
例如在字母 's' 和 't' 之间有两个额外的字母('s' 带有变音符号),因此这部分字母表变为:'... q r s ṣ š t u ...'
。
默认情况下,sort
将第一个单词放在不带变音符号的字母开头,并且仅放在它们之后——以 ṣ 和 š 开头的单词:
> my @words = <talk štraw šhabby ṣtraw swamp>
[talk štraw šhabby ṣtraw swamp]
> @words.sort
(swamp talk šhabby štraw ṣtraw)
我编写了以下程序来实现 'modified' 字母表的规则,其中我将 'ṣ'
和 'š'
替换为 's' 和一些最后的 Unicode 字符(希望这些字符永远不会出现在我的真实数据中,至少不会出现在 's'
之后)。
my $end = 0x10FFFF;
my @last = map * + $end, -10..0;
my @chr_last = @last».chr; # 11 last
# Unicode characters
my Str sub diacr( $word ) {
my $temp = $word;
$temp ~~ s:g/ṣ/s@chr_last[0]/;
$temp ~~ s:g/š/s@chr_last[1]/;
return $temp;
}
my @words = <talk štraw šhabby ṣtraw swamp>;
say @words;
say @words.sort(&diacr);
# (swamp ṣtraw šhabby štraw talk)
它有效并希望给出正确的结果,但我觉得应该有一种更优雅、更直接的方法来做同样的事情。
UPD: Here's a discussion about experimental features 喜欢 collate
和 coll
,但我不知道如何使用它们来解决我的特定问题.
我也找不到简单的方法。但无论如何,这是与您已经做过的相同方向的另一种尝试:
sub transform($char) {
state @order = [<s ṣ š>, <a â>];
my $non_mark_char = $char.samemark("a");
for @order -> $subset {
my $pos = $subset.grep($char, :k);
die "Unexpected subset $subset" if $pos.elems > 1;
if $pos.elems == 1 {
$pos = $pos[0] + ord("0");
return $non_mark_char ~ chr($pos);
}
}
return $char;
}
my Str sub diacr($word) {
return $word.comb.map({ transform($_) }).join('');
}
my @words = <tâlk talk štraw šhabby ṣtraw swamp>;
say @words.sort(&diacr);
输出:
(swamp ṣtraw šhabby štraw talk tâlk)
我必须使用不同的 'modified' 字母对字符串列表进行排序。
例如在字母 's' 和 't' 之间有两个额外的字母('s' 带有变音符号),因此这部分字母表变为:'... q r s ṣ š t u ...'
。
默认情况下,sort
将第一个单词放在不带变音符号的字母开头,并且仅放在它们之后——以 ṣ 和 š 开头的单词:
> my @words = <talk štraw šhabby ṣtraw swamp>
[talk štraw šhabby ṣtraw swamp]
> @words.sort
(swamp talk šhabby štraw ṣtraw)
我编写了以下程序来实现 'modified' 字母表的规则,其中我将 'ṣ'
和 'š'
替换为 's' 和一些最后的 Unicode 字符(希望这些字符永远不会出现在我的真实数据中,至少不会出现在 's'
之后)。
my $end = 0x10FFFF;
my @last = map * + $end, -10..0;
my @chr_last = @last».chr; # 11 last
# Unicode characters
my Str sub diacr( $word ) {
my $temp = $word;
$temp ~~ s:g/ṣ/s@chr_last[0]/;
$temp ~~ s:g/š/s@chr_last[1]/;
return $temp;
}
my @words = <talk štraw šhabby ṣtraw swamp>;
say @words;
say @words.sort(&diacr);
# (swamp ṣtraw šhabby štraw talk)
它有效并希望给出正确的结果,但我觉得应该有一种更优雅、更直接的方法来做同样的事情。
UPD: Here's a discussion about experimental features 喜欢 collate
和 coll
,但我不知道如何使用它们来解决我的特定问题.
我也找不到简单的方法。但无论如何,这是与您已经做过的相同方向的另一种尝试:
sub transform($char) {
state @order = [<s ṣ š>, <a â>];
my $non_mark_char = $char.samemark("a");
for @order -> $subset {
my $pos = $subset.grep($char, :k);
die "Unexpected subset $subset" if $pos.elems > 1;
if $pos.elems == 1 {
$pos = $pos[0] + ord("0");
return $non_mark_char ~ chr($pos);
}
}
return $char;
}
my Str sub diacr($word) {
return $word.comb.map({ transform($_) }).join('');
}
my @words = <tâlk talk štraw šhabby ṣtraw swamp>;
say @words.sort(&diacr);
输出:
(swamp ṣtraw šhabby štraw talk tâlk)