CY's Take on The Weekly Challenge #162
If you want to challenge yourself on programming, especially on Perl and/or Raku, go to https://theweeklychallenge.org, code the latest challenges, submit codes on-time (by GitHub or email).
Do tell me, if I am wrong or you strongly oppose my statements!
It's time for challenges in Week #162 !
April 2022 was an uneasy month for me. Now, May has come. But this does not mean that life in May 2022 is not going to be tougher.
Anyway... I have enjoyed this week's tasks and have worked them in Julia as well as in Perl. I wrote the Perl codes first, then, mostly following the logic of the Perl codes, finished the Julia codes. I borrowed the book Think Julia from the re-opened public library, and have been reading it seriously to have a comprehensive elementary understanding for the Julia language.
EVERYONE will be VERY AMAZED if you can "decrypt" these characters.
I mentioned before "[some] people stating that Julia is a functional programming language", then this week I found this post on functional programming style of Julia in JuliaLang Discourse. In short, Julia is not a functional programming language, but it's very handy to implement a functional programming style in Julia using certain packages. So I will still dive(fall?) deeply in JuliaLang.
Task 1: ISBN-13
Refer to the English Wikipedia: ISBN-13.
The task statement is ambiguous. I decided to implement two functions, one for checking whether a 13-digit ISBN has the reasonable check digit (valid), one for, given a 12-digit string, giving the user the check digit (lookup).
The fun part for me is using the subroutine valid to complete the subroutine lookup.
Perl Solution
sub lookup {
my $partial_code = $_[0];
return first {valid($partial_code.$_)} (0..9);
}
sub valid {
my $code = $_[0];
my @d = grep { /\d/ } split "", $code;
die "Invalid ISBN-13 code!\n" if scalar @d != 13;
return !( ($d[12] + sum pairmap {$a + 3*$b} @d[0..11]) % 10);
}
Julia Solution
using IterTools
function p_int(s)
return parse(Int64, s)
end
function lookup(partialisbn)
return only(filter( d -> valid(partialisbn * string(d)), 0:9) )
end
function valid(isbn)
weight = push!(repeat( [1,3], 6), 1)
arr = p_int.(collect(
takestrict(
(filter(d-> (tryparse(Int64,d) isa Number),
split(isbn, ""))),
13)))
return sum(Base.splat(*),zip(weight,arr)) % 10 == 0
end
... Task 1
One thing that my code should be improved is that both scripts do not strictly check whether the string input (usually xxx-xxx-xx...-x) is made of nothing besides hypen and the correct total number of digits.
Task 2: Wheatstone-Playfair cipher
Refer to the English Wikipedia: Playfair cipher.
This is a complicated task, but not algorithmically difficult. And the encryption method itself is quite funny.
The procedure to encrypt a message with a given key is:
- Build the encryption 5×5-board, which depends on the key string.
- Do some minor preprocessing on the message, then pair up the alphabets.
- Transform the alphabet pairs into a completely different alphabet pairs, based on the encryption board.
- Join the new alphabet pairs and the resultant is the cryptic text.
For the Perl script, tools from List::Util are used extensively. For the Julia script, some interesting type considerations are applied in the Julia codes. Julia has a very rich amount of types (probably for its mathematical modelling applications to attract the scientists and engineers), such as Tuple, Array(==Vector), Vector{Vector{type}}, n×m Matrix...
Note that the design of Julia have been influnced by Perl. But I found it is a bit funny to see that, for the join or split, the order of parameters used in these two languages is exactly opposite.
(1) in Perl
sub playfair_board {
my $key = (uc $_[0]) . (join "", ("A".."Z"));
$key =~ tr/J/I/;
my @let = uniqstr grep {$_ ne " "} split "", $key;
@let = (
[@let[0..4] ],
[@let[5..9] ],
[@let[10..14]],
[@let[15..19]],
[@let[20..24]],
) ;
return [@let];
}
(1) in Julia
function playfair_board(key)
letters = unique(Base.vcat(
filter( c -> c != ' ' ,
only_special.(split(uppercase(key), ""))
),
Char.(vcat(codepoint('A'):codepoint('I'),
codepoint('K'):codepoint('Z'))
)
))
board_vv = [ letters[ 1:5],
letters[ 6:10],
letters[11:15],
letters[16:20],
letters[21:25] ]
return Char.(transpose(codepoint.(reduce(hcat,board_vv))))
# transpose(reduce(hcat,board_vv)) does not work!
end
Review of (1)
Slicing is a good stuff!
(2) in Perl
sub preprocess {
my $word = uc $_[0];
$word =~ s/\W//g;
$word =~ tr/J/I/;
my $pword; # BEGIN: insert X for repeating char
do {
$pword = $word;
$word =~ s/([A-Z])\1/${1}X${1}/;
} while ($pword ne $word); # END of insertion
return $word;
}
sub pairup {
my $word = $_[0];
$word = $word."X" if (length $word) % 2 == 1;
return [pairmap {$a.$b} split "", $word];
}
(2) in Julia
function preprocess(word)
word = replace(uppercase(word), " " => "", "J" => "I")
word_a = split(word, "")
new_word_a = []
for i in 1:(length(word_a)-1)
push!(new_word_a, word_a[i])
if word_a[i] == word_a[i+1]
push!(new_word_a, "X")
end
end
new_word = join(new_word_a,"")*word_a[end]
return new_word
end
function pairup(word)
if length(word) % 2 == 1
word *= "X"
end
word_h = []
word_t = []
flip = true
for c in word
if flip
push!(word_h, c)
else
push!(word_t, c)
end
flip = !flip
end
return zip(word_h, word_t)
end
Review of (2)
I am sad that I hasn't been good at regular expression. Loop contructs (do-while loop in Perl, for-loop in Julia) are used to insert the seperator "X".
(3)-(4) in Perl
sub codify {
my $board = $_[0];
my @wordpairs = $_[1]->@*;
my @en_wordpairs;
for (@wordpairs) {
my ($e, $f) = split "", $_;
my ($x1,$y1) = seek_xy($board, $e);
my ($x2,$y2) = seek_xy($board, $f);
# case: lay on same column
if ($x1 == $x2) {
push @en_wordpairs,
$board->[$x1][($y1+1)%5].$board->[$x1][($y2+1)%5];
next;
}
# case: lay on same row
if ($y1 == $y2) {
push @en_wordpairs,
$board->[($x1+1)%5][$y1].$board->[($x2+1)%5][$y2];
next;
}
# case: form a rectangle
push @en_wordpairs, $board->[$x1][$y2].$board->[$x2][$y1];
}
return join "", @en_wordpairs;
(3)-(4) in Julia
function codify(key, word)
board = playfair_board(key)
zipped_words = pairup(preprocess(word))
encrypted_v = []
for p in collect(zipped_words)
(x1, y1) = Tuple(findfirst(c->c==first(p), board))
(x2, y2) = Tuple(findfirst(c->c== last(p), board))
if x1 == x2
push!(encrypted_v, board[x1, 1+y1%5] * board[x2, 1+y2%5])
continue
end
if y1 == y2
push!(encrypted_v, board[1+x1%5, y1] * board[1+x2%5, y2])
continue
end
push!(encrypted_v, board[x1,y2] * board[x2,y1])
end
return join(encrypted_v, "")
end
... Task 2
I have done the decryption in Perl but not in Julia, because of the lack of time (personal issues next week). Probably I'm going to code it later this week or next week. And, perhaps I should refactor more on the script as the later part of the subroutine decode is so similar to the subroutine codify.
decryption in Perl
sub decrypt {
my $key = $_[0];
my $encoded = uc $_[1];
$encoded =~ s/\W//g;
$encoded =~ s/J/I/g;
die "Bad cryptotext (non-alphabet characters).\n"
if $encoded !~ /^[A-Z]+$/;
die "Bad cryptotext (odd number of characters). \n"
if (length $encoded) % 2 != 0;
my $board = playfair_board($key);
return decode($board, $encoded);
}
sub decode {
my $board = $_[0];
my $encoded = $_[1];
my @wordpairs = pairmap {$a.$b} split "", $encoded;
my @de_wordpairs;
for (@wordpairs) {
my ($e, $f) = split "", $_;
my ($x1,$y1) = seek_xy($board, $e);
my ($x2,$y2) = seek_xy($board, $f);
# case: lay on same column
if ($x1 == $x2) {
push @de_wordpairs,
$board->[$x1][($y1+4)%5].$board->[$x1][($y2+4)%5];
next;
}
# case: lay on same row
if ($y1 == $y2) {
push @de_wordpairs,
$board->[($x1+4)%5][$y1].$board->[($x2+4)%5][$y2];
next;
}
# case: form a rectangle
push @de_wordpairs, $board->[$x1][$y2].$board->[$x2][$y1];
}
return join "", @de_wordpairs;
}
Thanks for reading.
Believe me or not, sometimes colouring is enough for expressions. □
Except from images and codes from other personnels, the content of this blogpost is released under a copyleft spirit. One may share (full or partial) content of this blogpost on other platform if you share it under the free and open content spirit.
link for CY's full codes: ch-1.pl, ch-2.pl, ch-1.jl, ch-2.jl
Contact on twitter: @e7_87.
Discuss via GitHub issues: here.
Email: fungcheokyin at gmail.com
Created Date: 1st May, 2022.
Last Edited: 1st May, 2022. 16:25 HKT.