laurent_r

These are some answers to the Week 97 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Task 1: Caesar Cipher

You are given string $S containing only the letters A..Z and a number $N.

Write a script to encrypt the given string $S using a Caesar Cipher with left shift of size $N.

Example:

Input: $S = "THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG", $N = 3
Output: "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 Caesar cypher is a weak form of encryption that involves “rotating” each letter of the input string by a fixed number of places. To rotate a letter means to shift it through the alphabet, wrapping around to the end if necessary. In the movie 2001: A Space Odyssey, the spaceship’s computer is called HAL, which is IBM left rotated by 1.

Note that the task description says that the input string contains only the letters A..Z, but the example provided also contains spaces which are not in the encrypted solution. So we need to handle spaces as a special case. Depending on the language, my solutions will either handle spaces as one special case, or decide not to convert any letter outside of the A..Z range in order, for example, to preserve also punctuation marks).

Caesar Cipher in Raku

I decided to implement the solution in a functional style (to make the porting to Scala easier). So almost everything is made in a map block that processes each letter in turn and returns a stream of converted letters that are then join into the cypher string. Note that in the Raku solution, we convert only the letters the A..Z range.

use v6;
constant $default = "THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG";
constant $min = 'A'.ord;
constant $max = 'Z'.ord;

sub MAIN (Str $in-string = $default, Int $shift = 3) {
    say rotate($in-string.uc, $shift);
    #say $out;
}
sub rotate ($in, $shift) {
    return join "", 
        map { my $let= $_ - $shift; 
              $let +=  26 if $let < $min; 
              $min <= $_ <= $max ?? $let.chr !! $_.chr; 
            }, $in.comb>>.ord;
}

This script displays the following output:

$ raku caesar.raku
QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD

Note that there is a special case of Caesar cipher called ROT13, where each letter is rotated by 13 places. Since 13 is half of the number of letters in our alphabet, applying ROT13 twice returns the original string, so that the same code may be used to encode and decode a string. ROT13 was commonly used on the Internet to weakly hide potentially offensive jokes or solutions to puzzles. With a fixed shift of 13, the code might be much simpler and can be contained in a simple one-liner:

$ raku -e 'my $w = @*ARGS[0]; $w ~~ tr/A..MN..Z/N..ZA..M/; say $w;' FOOBAR
SBBONE

$ raku -e 'my $w = @*ARGS[0]; $w ~~ tr/A..MN..Z/N..ZA..M/; say $w;' SBBONE
FOOBAR

Caesar Cipher in Perl

This is essentially a port to Perl of the Raku program, except that, here, only the space character is handled differently:

use strict;
use warnings;
use feature "say";
use constant MIN => ord 'A';

my $in_string = shift // "THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG";
my $shift = shift // 3;
say rotate(uc $in_string, $shift);

sub rotate {
    my ($in, $shift) = @_;
    return join "", 
        map { my $let = ord($_) - $shift; 
              $let +=  26 if $let < MIN; 
              $_ eq " " ? " " : chr $let 
            } split "", $in;
}

This script displays the following output:

$ perl  caesar.pl
QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD

In the specific case of ROT13 (Caesar cipher with a shift of 13 letters), we can also use a simple Perl one-liner:

$ perl -E '$w = shift; $w =~ tr/A-MN-Z/N-ZA-M/; say $w;' FOOBAR
SBBONE

$ perl -E '$w = shift; $w =~ tr/A-MN-Z/N-ZA-M/; say $w;' SBBONE
FOOBAR

Caesar Cipher in Scala

This a simple port to Scala of the Raku and Perl programs above.

object caesar extends App {
  val test = "THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG"
  val shift = 3
  println( test.map(convert(_, shift)))

  def convert(c: Char, shift: Int): Char = {
    val min = 'A'.toByte
    val asc = c.toByte - shift;
    val conv = if (asc < min) asc + 26 else asc
    return if (c == ' ') ' ' else conv.toChar
  }
}

Output:

QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD

Caesar Cipher in Python

Again, a port to Python of the Raku and Perl programs above. Except that functional programming is much less easy in Python, so we use a more conventional procedural approach. Since Python makes it possible to chain comparison operators, it makes it simple to convert only the letters the A..Z range.

ALPHA_COUNT = 26
MIN = ord('A')

input_string = "THE QUICK BROWN FOR JUMPS OVER THE LAZY DOG"
shift = 3
out = ""
for char in input_string:
    if 'A' <= char <= 'Z':
        asc_code = ord(char) - shift
        if asc_code < MIN:
            asc_code += ALPHA_COUNT
        out += chr(asc_code)
    else:
        out += char
print(out)

This script displays the following output:

$ python3 caesar.py
QEB NRFZH YOLTK CLO GRJMP LSBO QEB IXWV ALD

Task #2: Binary Substrings

You are given a binary string $B and an integer $S.

Write a script to split the binary string $B into substrings of size $S and then find the minimum number of flips required to make all substrings the same.

Example 1:

Input: $B = “101100101”, $S = 3
Output: 1

Binary Substrings:
    "101": 0 flip
    "100": 1 flip to make it "101"
    "101": 0 flip

Example 2:

Input $B = “10110111”, $S = 4
Output: 2

Binary Substrings:
    "1011": 0 flip
    "0111": 2 flips to make it "1011"

It isn’t really necessary to actually split the input string. We can iterate over the substrings and, for each position, find the number of 1s (or 0s, it’s your draw). So, in each position, we sum the minimum of the number of 1s and the number of 0s.

Binary Substrings in Raku

With the above explanations, this is hopefully clear:

use v6;
subset Binstr of Str where /^<[01]>*$/;

sub MAIN (Binstr $in-string,  Int $size) {
    my $sub-str-len = $in-string.chars / $size;
    my $flips = 0;
    for 0..^$sub-str-len -> $i {
        my $ones = 0;
        for 0..^$size -> $j {
            my $idx = $j * $sub-str-len + $i;
            $ones++ if substr($in-string, $idx, 1) == 1
        }
        my $zeroes = $size - $ones;
        $flips += min ($zeroes, $ones)
    }
    say $flips;
}

Output:

$ ./raku bin-substrings.raku  101100101 3
1

$ ./raku bin-substrings.raku  10110111 4
2

Binary Substrings in Perl

This is the same idea as above for the Perl version:

use strict;
use warnings;
use feature qw/say/;

my ($in_string, $size) = @ARGV;
my $sub_str_len = length($in_string) / $size;
my $flips = 0;
for my $i (0 .. $sub_str_len - 1) {
    my $ones = 0;
    for my $j (0 .. $size - 1) {
        my $idx = $j * $sub_str_len + $i;
        $ones++ if substr ($in_string, $idx, 1) == 1;
    }
    my $zeroes = $size - $ones;
    $flips += $zeroes > $ones ? $ones : $zeroes;
}
say $flips;

Output:

$ perl  bin-substrings.pl 101100101 3
1

$ perl  bin-substrings.pl  10110111 4
2

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, February 7, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.