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[0] 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'.$_->[1].'b',$_->[0])} @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);
}
```

Comments on this post are now closed. If you have particular grounds for adding a late comment, comment on a more recent post quoting the URL of this one.