Perl Weekly Challenge: Week 22
Challenge 1:
Write a script to print first 10 Sexy Prime Pairs. Sexy primes are prime numbers that differ from each other by 6. For example, the numbers 5 and 11 are both sexy primes, because 11 - 5 = 6. The term “sexy prime” is a pun stemming from the Latin word for six: sex. For more information, please checkout wiki page.
To solve this problem in Perl5, I once again trotted out the isPrime()
function I originally wrote for week 12. I also reused the nextPrime()
function from week 15.
my @sexyPrimes;
while (scalar @sexyPrimes < 10) {
my $p = nextPrime();
if (isPrime($p + 6)) {
push @sexyPrimes, [$p, $p + 6];
}
}
for my $sp (@sexyPrimes) {
say "$sp->[0], $sp->[1]";
}
All I'm doing is going through the sequence of prime numbers and adding 6. If that number is also prime, we have a sexy prime pair.
Feeling the need for a bit more of a challenge I decided to see if I could do the Perl6 version as a one liner and I came up with this:
perl6 -e '(1..∞).grep({.is-prime}).map({($_,$_+6) if ($_+6).is-prime})[^10].map({.join(q{, }).say});'
Challenge 2:
Write a script to implement Lempel-Ziv-Welch (LZW) compression algorithm. The script should have method to encode/decode algorithm. The wiki page explains the compression algorithm very nicely.
It turned out implementing this algorithm was less daunting than it initially appeared. Apart from Wikipedia I found this page to be helpful.
This is the Perl5 code:
sub init_dict {
my %dictionary = map { chr $_ => chr $_ } 0 .. 255;
return \%dictionary;
}
sub uncompress {
my ($data) = @_;
my @output;
my $dict = init_dict();
my $i = scalar keys %{$dict};
my $l = 0;
my $p = $data->[$l];
my $s = $dict->{$p};
my $c = substr $s, 0, 1;
push @output, $s;
while ($l < scalar @{$data} - 1) {
my $n = $data->[++$l];
if (!exists $dict->{$n}) {
$s = "$dict->{$p}$c";
} else {
$s = $dict->{$n};
}
push @output, $s;
$c = substr $s, 0, 1;
$dict->{++$i} = "$dict->{$p}$c";
$p = $n;
}
return join q{}, @output;
}
sub compress {
my ($data) = @_;
my @output;
my $dict = init_dict();
my $i = scalar keys %{$dict};
my $l = 0;
my $p = substr $data, $l, 1;
while ($l < length $data) {
my $c = substr $data, ++$l, 1;
if (exists $dict->{"$p$c"}) {
$p = "$p$c";
} else {
push @output, $dict->{$p};
$dict->{"$p$c"} = ++$i;
$p = $c;
}
}
push @output, $dict->{$p};
return \@output;
}
And here is Perl6 which is just a translation of the Perl5 code above.
sub init_dict {
return (0 .. 255).map({ $_.chr => $_.chr});
}
sub uncompress(@data) {
my @output;
my %dict = init_dict();
my $i = %dict.elems;
my $l = 0;
my $p = @data[$l];
my $s = %dict{$p};
my $c = $s.substr(0, 1);
@output.push($s);
while $l < @data.elems - 1 {
my $n = @data[++$l];
if %dict{$n}:!exists {
$s = "%dict{$p}$c";
} else {
$s = %dict{$n};
}
@output.push($s);
$c = $s.substr(0, 1);
%dict{++$i} = "%dict{$p}$c";
$p = $n;
}
return @output.join(q{});
}
sub compress(Str $data) {
my @output;
my %dict = init_dict();
my $i = %dict.elems;
my $l = 0;
my $p = $data.substr($l, 1);
while $l < $data.chars {
my $c = $data.substr( ++$l, 1);
if %dict{"$p$c"}:exists {
$p = "$p$c";
} else {
@output.push(%dict{$p});
%dict{"$p$c"} = ++$i;
$p = $c;
}
}
@output.push(%dict{$p});
return @output;
}
One thing I wanted to do for both versions was to make them into proper command-line utils like the Unix compress and uncompress. To do this I would need some way of
writing the output of my compress()
function to disk in a form which could be read back in by uncompress()
. I think the way to do that involves Perls' pack()
and unpack()
functions. But I discovered to my chagrin I have forgotten how they worked. (Or, come to think of it, did I ever know?) I made some small attempts but with the deadline approaching I gave up for now. It will be an interesting project to pursue at some later date.