Perl Weekly Challenge: Week 177
Challenge 1:
Damm Algorithm
You are given a positive number,
$n.Write a script to validate the given number against the included check digit.
Please checkout the wikipedia page for information.
Example 1
Input: $n = 5724
Output: 1 as it is valid number
Example 2
Input: $n = 5727
Output: 0 as it is invalid number
Although the spec only talks about validation, I decided to add code to compute the check digit as well.
In Raku we can have multiple subroutines with the same name providing they have different signatures.
This is the version of MAIN() that handles computing the check digit. In Raku, required Boolean parameters to
MAIN() such as :$c! have a certain "magic" that treates them as command line switches. So to compute a checkdigit for a particular number we would call it like this: ch-2.raku -c <number>. (In hindsight I see that I have mistakenly referred to a 'checksum' in the help text instead of 'check digit'.)
multi sub MAIN(
Int $n, #= a number
Bool :$c! #= compute checksum
) {
The original number is printed followed by its check digit which is computed in a function naturally called
checkdigit() which will be explained below.
say $n, checkdigit($n);
}
This is the version of MAIN() which validates a number with an appended check digit. The difference in the
signature is that the boolean parameter is :$v! so it would be invoked from the command line like this: ch-2.raku -v <number with check digit>.
multi sub MAIN(
Int $n, #= a number
Bool :$v! #= validate checksum
) {
It uses the checkdigit() routine again but this time it checks that the check digit of the number provided is 0. If it is, the
number is valid so 1 is printed otherwise 0 is printed.
say (checkdigit($n) == 0) ?? 1 !! 0;
}
So what is this checkdigit() subroutine? It takes a number as input.
sub checkdigit(Int $n) {
The number is split into digits.
my @digits = $n.comb;
An interim value for the checkdigit is set to 0.
my Int $interim = 0;
Every digit, $i, is treated as a column, and the current interim value as a row, in a lookup table via
the lookup() function. The result of that lookup becomes the next interim value.
for @digits -> $i {
$interim = lookup($i.Int, $interim);
}
After all the digits have been processed, the last interim value is the value of the check digit so it is returned as the result of the function.
return $interim;
}
The lookup() function is just an access into a 2d array. It could have been placed inline in checkdigit() but I thought
it is more flexible this way as there are several different formulas the Damm algorithm can use producing different lookup tables.
sub lookup(Int $col, Int $row) {
my @table = [
[ 0, 3, 1, 7, 5, 9, 8, 6, 4, 2 ],
[ 7, 0, 9, 2, 1, 5, 4, 8, 6, 3 ],
[ 4, 2, 0, 6, 8, 7, 1, 3, 5, 9 ],
[ 1, 7, 5, 0, 9, 8, 3, 4, 2, 6 ],
[ 6, 1, 2, 3, 0, 4, 5, 9, 7, 8 ],
[ 3, 6, 7, 4, 2, 0, 9, 5, 8, 1 ],
[ 5, 8, 6, 9, 7, 2, 0, 1, 3, 4 ],
[ 8, 9, 4, 5, 3, 6, 2, 0, 1, 7 ],
[ 9, 4, 3, 8, 6, 1, 7, 2, 0, 5 ],
[ 2, 5, 8, 1, 4, 3, 6, 7, 9, 0 ],
];
return @table[$row;$col];
}
The Perl version works the same so I will provide just a few comments on notable differences.
I used the [Getopt::Std](https://metacpan.org/pod/Getopt::Std) module to provide the command line switch behavior the Raku version has.
our ($opt_c, $opt_v);
getopts("c:v:");
if (defined $opt_c) {
my $n = $opt_c;
say $n, checkdigit($n);
} elsif (defined $opt_v) {
my $n = $opt_v;
say checkdigit($n) == 0 ? 1 : 0;
} else {
usage();
}
sub checkdigit {
my ($n) = @_;
my @digits = split //, $n;
my $interim = 0;
for my $i (@digits) {
$interim = lookup($i, $interim);
}
return $interim;
}
sub lookup {
my ($col, $row) = @_;
2d arrays are a little awkward in Perl; you have to specify them as an array of array references.
my @table = (
[ 0, 3, 1, 7, 5, 9, 8, 6, 4, 2 ],
[ 7, 0, 9, 2, 1, 5, 4, 8, 6, 3 ],
[ 4, 2, 0, 6, 8, 7, 1, 3, 5, 9 ],
[ 1, 7, 5, 0, 9, 8, 3, 4, 2, 6 ],
[ 6, 1, 2, 3, 0, 4, 5, 9, 7, 8 ],
[ 3, 6, 7, 4, 2, 0, 9, 5, 8, 1 ],
[ 5, 8, 6, 9, 7, 2, 0, 1, 3, 4 ],
[ 8, 9, 4, 5, 3, 6, 2, 0, 1, 7 ],
[ 9, 4, 3, 8, 6, 1, 7, 2, 0, 5 ],
[ 2, 5, 8, 1, 4, 3, 6, 7, 9, 0 ],
);
This makes the calling syntax a little ungainly too. Nothing too difficult to grasp but the Raku syntax is better.
return $table[$row]->[$col];
}
Challenge 2:
Palindromic Prime Cyclops
Write a script to generate
first 20 Palindromic Prime Cyclops Numbers.A cyclops number is a number with an odd number of digits that has a zero in the center only.
Output
101, 16061, 31013, 35053, 38083, 73037, 74047, 91019, 94049,
1120211, 1150511, 1160611, 1180811, 1190911, 1250521, 1280821,
1360631, 1390931, 1490941, 1520251
The structure of the script, is by now standard for me. A loop that counts up consecutive integers applying a function that returns a boolean result as to whether the integer meets the problems' criteria or not. If it does, it is added to a list of results and when the number of results specified has been reached, the loop is exited and the results printed out.
sub MAIN() {
my @ppc;
In this case because the prospective number has a 0 in the middle, we can ignore numbers with less than three digits. Furthermore, because all primes numbers except 2 are odd, we can ignore 100 and start from 101. Coincidentally, 101 is a palindromic prime cyclops.
my $n = 101;
while @ppc.elems <= 20 {
if isPalindromicPrimeCyclops($n) {
@ppc.push($n);
}
And because all primes (except 2) are odd, we can step through the loop by 2s, thereby ignoring even numbers.
$n += 2;
}
@ppc.join(q{, }).say;
}
This is the function that actually tests if a number is a Palindromic Prime Cyclops. It first checks if the number is prime
whith the built-in .is-prime() method. Then it checks if the number is the same as its reverse (i.e. if it is a palindrome.) Finally it checks if the middle digit is a 0 with .substr(). It has just occurred to me that I didn't check if the number has
an odd number of digits but I seem to have got the right output anyway. Was I just lucky or do all P.P.Cs have an odd number of digits?
sub isPalindromicPrimeCyclops(Int $n) {
return $n.is-prime && $n == $n.flip && $n.substr($n.chars / 2, 1) == 0;
}
This is the Perl version. Once again I had to deploy my trusty isPrime() function from previous challenges.
sub isPalindromicPrimeCyclops {
my ($n) = @_;
return (isPrime($n)) && ($n eq reverse $n) &&
(substr $n, (int ((length $n) / 2)), 1) eq '0';
}
The main body of the script works the same as in Raku.
my @ppc;
my $n = 101;
while (scalar @ppc <= 20) {
if (isPalindromicPrimeCyclops($n)) {
push @ppc, $n;
}
$n += 2;
}
say join q{, }, @ppc;