Caesarean Substrings With Raku and Perl
— 焉知非鱼Caesarean Substrings With Raku and Perl
[113] 发表于2021年1月30日。 这是我对 Perl 每周挑战#097 的回应。
挑战 #097.1: 凯撒密码 #
给你一个只包含字母 A..Z 的字符串 $S 和一个数字 $N。
写一个脚本，用凯撒密码对给定的字符串 $S 进行加密，左移大小为 $N。
例子: 输入: $S = “THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG”, $N = 3 输出: “QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD”
Plain: ABCDEFGHIJKLMNOPQRSTUVWXYZ Cipher: XYZABCDEFGHIJKLMNOPQRSTUVW
Plaintext: THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG Ciphertext: QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD
“只用字母 A...Z” 的表述是错误的，因为例子中也有几个空格。因此，应该允许这些空格。
文件: caesar-cipher
#! /usr/bin/env raku
subset AZ-space of Str where /^ <[ A .. Z \s ]>+ $/; # [1]
subset PosInt of Int where -25 <= $_ <= 25; # [2]
unit sub MAIN (AZ-space $S = 'THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG',
PosInt $N = 3); # [3]
say $S.comb.map({ caesar($_, $N) }).join; # [4]
sub caesar ($char, $shift)
{
return $char if $char eq " "; # [5]
my $code = $char.ord; # [6]
$code -= $shift; # [7]
$code += 26 if $code < 65; # 'A' # [8]
$code -= 26 if $code > 90; # 'Z' # [8a]
return $code.chr; # [9]
}
[1] 所允许的字符 (或 «特定领域字母»).
[2] 挑战说左移值是一个数字。允许除整数以外的任何东西是没有意义的，所以我把值限制在这个类型。负值应该是可以的，它们意味着右移值（而不是左移）。
[3] 参数，默认值为挑战中给出的值。
[4] 将字符串分割成单个字符（用梳子(comb)，在每个字符上应用 “caesar” 函数（用map），再次将字符连接成一个字符串（用join），然后打印出来。
[5] 不移动空格。
[6] 获取字符的代码点。
[7] 减去移位值（当我们向左移位时，或在字母表中降低移位值）。
[8] 绕回, 如果我们移出A-Z范围，这里为更低 - 或更高的 [8b]。
[9] 获取指定代码点的字符。
查看 docs.raku.org/routine/ord 获取更多关于 ord 的信息。
查看 docs.raku.org/routine/chr 获取更多关于 chr 的信息。
运行它:
$ ./caesar-cipher 'THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG' 3
QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD
$ ./caesar-cipher 'THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG' -3
WKH TXLFN EURZQ IRA MXPSV RYHU WKH ODCB GRJ
$ ./caesar-cipher 'THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG' 13
GUR DHVPX OEBJA SBK WHZCF BIRE GUR YNML QBT
$ ./caesar-cipher 'THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG' -13
GUR DHVPX OEBJA SBK WHZCF BIRE GUR YNML QBT
Raku 有一个 ords 变体，它接收一整个字符串，而不是一个字符作为 ord。还有 chrs，它接收一个代码点数组，并将它们变成一个字符串，而不是像 chr 那样接收一个字符的代码点。让我们用它们来写一个更短的程序。
文件: caesar-cipher-map
#! /usr/bin/env raku
subset AZ-space of Str where /^ <[ A .. Z \s ]>+ $/;
subset PosInt of Int where -25 <= $_ <= 25;
unit sub MAIN (AZ-space $S = 'THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG',
PosInt $N = 3);
say caesar($S, $N);
sub caesar ($string, $shift)
{
return $string.ords.map({$_ == 32 ?? 32 !! (($_ - $shift - 65) % 26 ) + 65}).chrs;
# #################### # 1a ############# ############ # 1b # 1c ## 1d
}
[1] 我们使用map来改变各个代码点。我们让代码点为32的空间单独存在[1a]。每一个其他的值我们都还原成0到25之间的数字（通过减去第一个字母的代码点（A：65）和移位值[1b]）。模数运算符 (%) 为我们处理负值，做正确的事情。例如：-2 % 26 -> 24 [1c]。然后我们添加调整值到它们应该在的位置(从A到Z)[1d]，然后我们将整个数组的代码点变成一个字符串。
查看 docs.raku.org/routine/ords 获取更多关于 ords 的信息。
查看 docs.raku.org/routine/chrs 获取更多关于 chrs 的信息。
运行它的结果和之前一样。
$ ./caesar-cipher-map 'THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG' 3
QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD
$ ./caesar-cipher-map 'THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG' -3
WKH TXLFN EURZQ IRA MXPSV RYHU WKH ODCB GRJ
$ ./caesar-cipher-map 'THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG' 13
GUR DHVPX OEBJA SBK WHZCF BIRE GUR YNML QBT
$ ./caesar-cipher-map 'THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG' -13
GUR DHVPX OEBJA SBK WHZCF BIRE GUR YNML QBT
Perl 版本 #
这是对第一个 Raku 版的直接翻译。
File: caesar-cipher-perl
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use feature 'signatures';
no warnings "experimental::signatures";
my $S = shift(@ARGV) // 'THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG';
die "Illegal characters" unless $S =~ /^[A-Z\s]+$/;
my $N = shift(@ARGV) // 3;
die "Illegal shift $N" if $N !~ /^\-?\d+$/ || $N < -25 || $N > 25;
say join("", map { caesar($_, $N) } split(//, $S));
sub caesar ($char, $shift)
{
return $char if $char eq " ";
my $code = ord($char);
$code -= $shift;
$code += 26 if $code < 65; # 'A'
$code -= 26 if $code > 90; # 'Z'
return chr($code);
}
运行它的结果和 Raku 版一样。
$ ./caesar-cipher-perl 'THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG' 3
QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD
$ ./caesar-cipher-perl 'THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG' -3
WKH TXLFN EURZQ IRA MXPSV RYHU WKH ODCB GRJ
$ ./caesar-cipher-perl 'THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG' 13
GUR DHVPX OEBJA SBK WHZCF BIRE GUR YNML QBT
$ ./caesar-cipher-perl 'THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG' -13
GUR DHVPX OEBJA SBK WHZCF BIRE GUR YNML QBT
挑战 #097.2：二进制子字符串(Binary Substrings) #
给你一个二进制字符串 $B 和一个整数 $S。
写一个脚本来拆分大小为 $S 的二进制字符串 $B，然后找出使其相同的最小翻转次数。
例 1: 输入: $B = “101100101”, $S = 3 输出: 1
二进制子字符串: “101”: 0 flip “100”: 1 flip to make it “101” “101”: 0 flip
例 2: 输入 $B = “10110111”, $S = 4 输出: 2
二进制子字符串: “1011”: 0 flip “0111”: 2 flips to make it “1011”
我们先从第一个例子中的二进制子字符串中砍掉3个字符块。
> say "101100101".comb(3); # -> (101 100 101)
> say "1011001010".comb(3); # -> (101 100 101 0)
第二行显示了如果长度不匹配会发生什么。这就给了我们一个非法的值，因为我们不能将一位数翻转为三位数的值。所以我们必须添加一个检查。
然后我们将第一个子串与其余的子串进行比较，一次一个。在这里使用bitwise XOR（Exclusive OR）运算符是一个合理的选择。这给了我们一个二进制值，其中1的数量就是该子串的翻转次数。Raku确实有一个XOR运算符。+^. 但是它 “将两个参数都强制为Int，并进行位智XOR操作”(根据文档"；参见docs.raku.org/language/operators#infix_+^)。
我们可以在进行XOR操作之前，将二进制值转换为十进制值。让我们试试。
获取翻转的次数。
> say ("10101".parse-base(2) +^ "10111".parse-base(2)).base(2).comb.sum; # -> 1
> say ("11101".parse-base(2) +^ "10111".parse-base(2)).base(2).comb.sum; # -> 2
这当然可行，但需要大量的代码。所以我将使用一个更简单的方法 - 逐个比较每个数字。
File: binary-substring
#! /usr/bin/env raku
subset BinaryString where /^ <[01]>+ $/; # [1]
subset PosInt of Int where * > 0; # [2]
unit sub MAIN (BinaryString $B = '101100101', # [1]
PosInt $S where $B.chars %% $S = 3, # [2]
:v(:$verbose));
my @B = $B.comb($S.Int); # [3]
my $first = @B.shift; # [4]
my $total = 0; # [5]
for @B -> $current # [6]
{
my $flip = bit-diff($first, $current); # [7]
$total += $flip; # [8]
say ": $first -> $current -> Flip: $flip" if $verbose;
}
say $total; # [9]
sub bit-diff ($a, $b) # [7]
{
my $flip = 0; # [10]
for ^$a.chars -> $index # [11]
{
$flip++ if $a.substr($index,1) ne $b.substr($index,1); # [12]
}
return $flip;
}
[1] 确保二进制字符串是合法的（只包含 “0 “和 “1”）。
[2] 确保是一个正整数，同时确保字符串是被它偶数分割的。(例如，“4 “给我们提供了长度为4的子串，如果最后一个较短，程序将中止。)
[3] 梳子通常用于将一个字符串分割成单个字符，但我们可以通过指定长度来获得每个子字符串中的多个字符，比如这样。
[4] 例子首先将第一个子串与自己进行比较，给出零翻转。这是愚蠢的(ish)，所以我跳过这一点，把第一个子串移出。
[5] 结果会到这里。
[6] 对于每一个子串（除了第一个，见[4]）。
[7] 获取每个子串的翻转次数。
[8] 并将其添加到总数中。
[9] 打印它。
[10] 翻转的数量会在这里。
[11] 对于两个子串中的每个索引（具有相同的长度）。
[12] - 如果给定位置上的字符不同，则在总数的基础上加1，意味着移动。
See docs.raku.org/routine/comb for more information about comb.
运行它。
$ ./binary-substring "101100101" 3
1
$ ./binary-substring -v "101100101" 3
: 101 -> 100 -> Flip: 1
: 101 -> 101 -> Flip: 0
1
$ ./binary-substring "10110111" 4
2
$ ./binary-substring -v "10110111" 4
: 1011 -> 0111 -> Flip: 2
2
看起来不错。
Perl #
这是对 Raku 版本的直接翻译，只是我必须实现 “comb”。
文件： binary-substring-perl
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use feature 'signatures';
use Getopt::Long;
no warnings "experimental::signatures";
my $verbose = 0;
GetOptions("verbose" => \$verbose);
my $B = shift(@ARGV) // '101100101';
die "Not a binary number" unless $B =~ /^[01]+$/;
my $S = shift(@ARGV) // 3;
die "Not an integer" unless $S =~ /^[1-9][0-9]*$/;
die "Not a legal length" if length($B) % $S;
my @B = comb($B, $S);
my $first = shift(@B);
my $total = 0;
for my $current (@B)
{
my $flip = bit_diff($first, $current);
$total += $flip;
say ": $first -> $current -> Flip: $flip" if $verbose;
}
say $total;
sub bit_diff ($a, $b)
{
my $flip = 0;
for my $index (0 .. length($a))
{
$flip++ if substr($a, $index,1) ne substr($b, $index,1);
}
return $flip;
}
sub comb ($string, $length = 1) # [1]
{
my @result;
while ($string)
{
push(@result, substr($string, 0, $length));
$string = substr($string, $length);
}
return @result;
}
[1] 缺失的 Raku 例程 “comb”。可选的第二个参数指定了它所返回的每个子串中所包含的（第一个参数的）子串长度。
运行它的结果与 Raku 版本相同。
$ ./binary-substring-perl "101100101" 3
1
$ ./binary-substring-perl -v "101100101" 3
: 101 -> 100 -> Flip: 1
: 101 -> 101 -> Flip: 0
1
$ ./binary-substring-perl "101100111" 3
2
$ ./binary-substring-perl -v "101100111" 3
: 101 -> 100 -> Flip: 1
: 101 -> 111 -> Flip: 1
2
就是这样。