Perl Weekly Challenge: Week 97
Challenge 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
Raku has all the tools you need to solve this one quickly and efficiently.
sub MAIN(
Str $S, #= a message to encrypt
Int $N #= number of letters to shift left in cipher
) {
my @plain = < A B C D E F G H I J K L M N O P Q R S T U V W X Y Z >;
my @cipher = @plain.rotate(-$N);
.rotate() handles the shifting. The only little gotcha here is that a positive operand shifts right.
It has to be a negative number to shift left.
$S.trans(@plain => @cipher).say;
Originally I was going to use a hash mapping letters to their encrypted values and transpose each letter
in the message with that but using .trans() is much easier.
}
sub rotateLeft {
my ($str, $n) = @_;
for (1 .. $n) {
unshift @{$str}, pop @{$str};
}
return @{$str};
}
my ($S, $N) = @ARGV;
my @plain = qw/ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z /;
my @cipher = rotateLeft(\@plain, $N);
Perl doesn't have .rotate() so I emulated it with the rotateLeft() function shown above.
say join q{}, map { $cipher[ord($_) - ord('A')] // $_; } (split //, $S);
It doesn't have .trans() either so what I did was to split the input string into an array of characters and map
their numeric values (which we can get with the ord() function) minus the numeric value of 'A'. This gives us indices
to the equivalent encrypted character in the @cipher array. If the value produced is outside the bounds of the array (i.e. a
character not between 'A' .. 'Z') it is passed through as-is. This resultant array of encrypted characters is joined back up
into a string and printed out.
Challenge 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"
This is my Raku solution.
sub MAIN(
Str $B, #= a binary string
Int $S #= size of substrings
) {
my @substrings = $B.comb($S.Int).map({ $_.parse-base(2); });
Usually I use .comb() without arguments to split a string into individual characters but it can
be used to split into groups of characters too. I had an unusual problem that using $S as an argument
didn't work correctly until I cast it to an Int. But I thought it already was an Int as it was declared
as such in the function parameters. I'll have to ask the experts why that is. Each of these integers is parsed
into a binary number format.
my $template = @substrings.shift;
The first substring will be chosen as the template that subsequent substrings will have to be altered to.
say [+] @substrings.map({ sprintf("%b", $template +^ $_) ~~ m:g/ 1 /; });
This is done by XOR'ing each substring with the template. The number of 1's in the result (which is the number of
digits that need to be flipped.) is counted and all the counts are totalled up via the [+] hyperoperator and the
total is printed.
}
This is the perl version. It's a bit more verbose because we lack some of the niceties Raku provides.
my ($B, $S) = @ARGV;
my @substrings = map { '0b' . $_; } unpack("(A$S)*", $B);
To convert $B into substrings in the absence of .comb() I used Perls obscure but powerful pack() function
which also converts the substrings into binary. '0b' has to be prefixed to each substring so Perl knows it is a
binary number not a string which happens to contain 1's and 0's. Forgetting this caused me a lot of problems in later
bits.
my $template = shift @substrings;
my $flips = 0;
for my $string (@substrings) {
$flips += sprintf('%b', oct($template) ^ oct($string)) =~ tr/1/1/;
}
Because we don't have [+], a for loop has to be used to traverse the substrings. I found that despite the 0b prefix, the
numbers would not be properly treated as binary unless run through the poorly-named oct() function first. Lastly, to count
the 1's in the result, I used the tr operator instead of m. This is a trick I learned when doing PWC 79 which contains a
similiar problem.
say $flips;