# RogerBW's Blog

Perl Weekly Challenge 22 24 August 2019

I've been doing the Perl Weekly Challenges. This one dealt with sexy primes and LZW encoding.

Yes, of course it's a pun: they're pairs of prime numbers separated by exactly 6. I borrowed my basic sieve of Eratosthenes from a previous challenge, then mapped the list into a hash for speed of lookup.

``````my \$cap=110;
my \$limit=6;

# Sieve of Eratosthenes to give us a prime list
my %n=map {\$_ => 1} (2..\$cap);
foreach my \$f (2..int(sqrt(\$cap))) {
map {(\$f<\$_ && \$_%\$f == 0)?delete \$n{\$_}:0} keys %n;
}
my @p=sort {\$a <=> \$b} (keys %n);
my %p=map {\$_ => 1} @p;

foreach my \$p (@p) {
my \$q=\$p+6;
if (exists \$p{\$q}) {
print "\$p, \$q\n";
\$limit--;
unless (\$limit) {
last;
}
}
}
``````

In perl6 we have the is-prime function, so we don't need the sieve. (Which is a shame, because it's an ideal use of the Set type.)

``````my \$limit=6;

for (2..Inf) -> \$p {
if \$p.is-prime {
my \$q=\$p+6;
if \$q.is-prime {
say "\$p, \$q";
\$limit--;
unless (\$limit) {
last;
}
}
}
}
``````

The second part of the challenge was to implement LZW compression. I didn't work this up in perl6, but this seems to work reasonably well in 5.

``````my \$lzw=Local::LZW->new('A'..'Z');
my \$bitstr=\$lzw->encode('TOBEORNOTTOBEORTOBEORNOT');
print \$lzw->decode(\$bitstr),"\n";

package Local::LZW;
use List::Util qw(max);
``````

The object is initialised with the dictionary.

``````sub new {
my \$class=shift;
my \$self={};
bless \$self,\$class;
my \$alphabet=join('',@_) or die "Specify alphabet\n";
my @dec=split '',\$alphabet;
unshift @dec,'#STOP#'; # yes, I know this is bad
\$self->{encode}={map {\$dec[\$_] => \$_} (0..\$#dec)};
return \$self;
}
``````

This pretty much follows the flow of the Wikipedia example.

``````sub encode {
my \$self=shift;
my @inchars=split '',shift;
push @inchars,'#STOP#';
my @out;
my %dict=%{\$self->{encode}};
my \$l=int(log(scalar keys %dict)/log(2))+1 ;
while (@inchars) {
if (\$inchars eq '#STOP#') {
last;
}
my \$n=0;
while (\$#inchars > \$n && exists \$dict{join('',@inchars[0..\$n])}) {
\$n++;
}
if (\$n>0) {
push @out,[\$dict{join('',@inchars[0..\$n-1])},\$l];
}
my \$di=scalar keys %dict;
\$l=max(int(log(\$di)/log(2))+1,\$l);
\$dict{join('',@inchars[0..\$n])}=\$di;
splice @inchars,0,\$n;
}
push @out,[\$self->{encode}{'#STOP#'},\$l];
``````

Perversely, the hardest thing to get right was the variable-length binary encoding. Well, encoding it isn't too hard…

``````  my \$bins=join('',map {sprintf('%0'.\$_->.'b',\$_->)} @out);
my \$ll=length(\$bins)%8;
if (\$ll>0) {
\$bins .= '0' x (8-\$ll);
}
return pack('B*',\$bins);
}
``````

But now we have to decode it, and that's a bit of a pain.

``````sub decode {
my \$self=shift;
my \$bitstr=shift;
my %dict=%{\$self->{encode}};
my %decode=map {\$dict{\$_} => \$_} keys %dict;
my \$l=int(log(scalar keys %dict)/log(2))+1 ;
my @bins=split '',join('',map {sprintf('%08B',ord(\$_))} split '',\$bitstr);
my @out;
my \$conj='';
while (@bins) {
my @d=splice @bins,0,\$l;
while (scalar @d < 8) {
unshift @d,'0';
}
my \$b=pack('B*',join('',@d));
my \$code=ord(\$b);
``````

From this point on it's relatively sensible. My "\$conj" is the conjectured dictionary entry without the final character (which at this point is unknown).

``````    unless (exists \$decode{\$code}) {
die "unable to decode \$code\n";
}
if (\$decode{\$code} eq '#STOP#') {
last;
}
push @out,\$decode{\$code};
if (\$conj) {
my \$nd=\$conj.substr(\$out[-1],0,1);
my \$di=scalar keys %decode;
\$l=max(int(log(\$di+1)/log(2))+1,\$l);
\$decode{\$di}=\$nd;
}
\$conj=\$out[-1];
}
return join('',@out);
}
``````