rakulang, dartlang, nimlang, golang, rustlang, lang lang no see

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

就是这样。