Perl Weekly Challenge: Week 15
After all of last weeks' excitement, doing this weeks challenges was pleasurable but uneventful.
Challenge 1:
Write a script to generate first 10 strong and weak prime numbers.
For example, the nth prime number is represented by p(n). p(1) = 2 p(2) = 3 p(3) = 5 p(4) = 7 p(5) = 11 Strong Prime number p(n) when p(n) > [ p(n-1) + p(n+1) ] / 2 Weak Prime number p(n) when p(n) < [ p(n-1) + p(n+1) ] / 2
I already had an isPrime() function from challenge 12 that I could reuse. I
won't repeat it here. In this problem however we can't just make a list of primes,
we need to have the next value ahead. so I wrapped that function in another
that, as the name suggests, gets the next prime number.
sub nextPrime {
state $i = 1;
while ($i++) {
if (isPrime($i)) {
return $i;
}
}
}
Armed with this, generating the strong and weak primes is easy.
my @primes = (nextPrime(), nextPrime());
my @strongPrimes;
my @weakPrimes;
for (my $i = 1; scalar @strongPrimes < 10 || scalar @weakPrimes < 10; $i++) {
push @primes, nextPrime();
my $meanOfNeighboringPrimes = ($primes[$i - 1] + $primes[$i + 1]) / 2;
if ($primes[$i] > $meanOfNeighboringPrimes) {
push @strongPrimes, $primes[$i];
} elsif ($primes[$i] < $meanOfNeighboringPrimes) {
push @weakPrimes, $primes[$i];
}
}
say 'The 1st 10 strong Primes: ', join q{, }, @strongPrimes;
say 'The 1st 10 weak Primes: ',join q{, }, @weakPrimes[0 .. 9];
I didn't include the case where $primes[$i] == $meanOfNeighboringPrimes because
the spec didn't ask for it but those particular primes are known as "balanced primes."
The only other feature of note is that we're going to get more weak primes than strong
ones so we have to use an array slice to print only the first 10. I knew that but I
don't use array slices very often so I was momentarily tripped up be forgetting that
the syntax requires the @ sigil in front of the array, not $.
The Perl6 version is even simpler and my solution takes full advantage of the languages "lazy lists."
multi sub MAIN() {
First we get a list of all the prime numbers. Fortunately we do not have to wait for the end of the universe to get this because a lazy list only computes values on demand. (By the way, I love how you can use unicode symbols as syntax in Perl6. But if your editor can't cope, you can use * instead of ∞.)
my @primes = (1 .. ∞).grep({ .is-prime });
Now two lazy lists of strong and weak primes respectively. We grep through our list of primes and get the ones that meet our criteria and then map them back into an array.
my @strongPrimes = (1 .. ∞)
.grep({ @primes[$_] > (@primes[$_ - 1] + @primes[$_ + 1]) / 2 })
.map({ @primes[$_] });
my @weakPrimes = (1 .. ∞)
.map({ @primes[$_] })
.grep({ @primes[$_] < (@primes[$_ - 1] + @primes[$_ + 1]) / 2 });
The array slice [^10] reduces our infinite lists to a more managable 10.
say 'The 1st 10 strong Primes: ', join q{, }, @strongPrimes[^10];
say 'The 1st 10 weak Primes: ',join q{, }, @weakPrimes[^10];
}
Challenge 2:
Write a script to implement Vigenére cipher. The script should be able encode and decode. Checkout wiki page for more information.
In Perl5 I used the standard libraries' Getopt::Std module to handle command line switches. prep() just does some basic cleanup of the input such as converting
it to uppercase and removing non-alphabetic characters.
my %opts;
getopts('dek:m:', \%opts);
my $message = prep($opts{m} // usage());
my $key = prep($opts{k} // usage());
if (defined $opts{'d'}) {
say vigenere($message, $key, \&decrypt);
} elsif (defined $opts{'e'}) {
say vigenere($message, $key, \&encrypt);
} else {
usage();
}
In Perl6 command line switches (along with usage help) is handled by parameters to
sub MAIN. There are two separate sub MAINs with different signatures to handle
encryption and decryption.
multi sub MAIN (
Bool :$d!, #= decrypt a message
Str :$k!,
Str :$m!
) {
vigenére($k, $m, &decrypt);
}
multi sub MAIN (
Bool :$e!, #= encrypt a message
Str :$k!, #= key for encryption/decryption
Str :$m! #= message to encrypt/decrypt
) {
vigenére($k, $m, &encrypt);
}
As the bulk of the process is the same for encryption I centralized it in a function vigenere which takes a reference to a function as its' third parameter. That function is then called to do the actual work of encryption or decryption.
sub vigenere {
my @message = split //, $_[0];
my @key = split //, $_[1];
my $op = $_[2];
my %tabulaRecta = makeSquare();
my $keylength = scalar @key;
return
join q{}, map { $op->(\@key, $keylength, \%tabulaRecta, $_); } @message;
}
Perl6 lets us include the accent in vigenére but otherwise it works the same.
sub vigenére($k, $m, &op) {
my %tabulaRecta = makeSquare();
my @key = prep($k).comb;
my $keylength = @key.elems;
my @message = prep($m).comb;
@message
.map({ op(@key, $keylength, %tabulaRecta, $_) })
.join
.say;
}
The "tabula Recta" which is a key component of the vigenére cipher is a table of the alphabet which is shifted by one letter in each row. We can represent it as a hash of strings. I was pretty sure this could be done in one line and in Perl6 I succeeded.
return (0 .. 25).map({ ['A' .. 'Z'].rotate($_).join; }).map({ $_.substr(0, 1) => $_};
(it is spread over several lines and wrapped in the makeSquare() function for legibility.) Alas for Perl5, I couldn't quite manage.
my @shifted = ('Z', 'A' .. 'Y');
return map {
push @shifted, shift @shifted;
$_ => join q{}, @shifted;
} 'A' .. 'Z';
The problem is that push returns the number of values pushed not the array itself.
Here almost anticlimactically, is the code that actually encrypts and decrypts
in Perl5:
sub decrypt {
my ($key, $keylength, $tabulaRecta, $c) = @_;
state $i = 0;
return
chr(ord('A') + index($tabulaRecta->{$key->[$i++ % $keylength]}, $c));
}
sub encrypt {
my ($key, $keylength, $tabulaRecta, $c) = @_;
state $i = 0;
return
substr($tabulaRecta->{$key->[$i++ % $keylength]}, ord($c) - ord('A'), 1);
}
...and Perl6:
sub decrypt(@key, $keylength, %tabulaRecta, $c) {
state $i = 0;
return chr(ord('A') + index(%tabulaRecta{@key[$i++ % $keylength]}, $c));
}
sub encrypt(@key, $keylength, %tabulaRecta, $c) {
state $i = 0;
return substr(%tabulaRecta{@key[$i++ % $keylength]}, ord($c) - ord('A'), 1);
}