perlmeditation
eyepopslikeamosquito
<P>
Continuing our 99 bottles of beer reduction from [id://997591|last time],
I decided at this point to step back and reconsider some basic assumptions.
In particular, though:
<CODE>
eval lc pack u,'source-string'
</CODE>
has served us well so far, can we do better?
</P>
<P>
Especially relevant to 99 bottles of beer are these two ideas:
<ul>
<li> Since we need to loop 99 times, why not exploit the "eval we have to do
anyway" for that? That is, string multiply the eval string like so: <C>eval lc pack(u,'source-string')x99</C>.
<li> In solutions that use <C>v</C> for space, we translate via
<C>y/v/\40/</C>. If this translation were done outside the eval, it could be
shortened by two strokes to <C>y/v/ /</C>; one stroke could similarly be saved
when translating to a hard newline. Though doing that outside the eval loses our
3/4 "pack u" compression, the saving in translation makes it worth considering at least.
</ul>
</P>
<P><B>Multiplying the eval string by 99</B></P>
<P>
All the beer bottle algorithms seen so far
loop from zero up to 99,
building a single large string inside the loop --
and printing it in one go at the end.
This (unnatural) algorithm has proven to produce the
shortest solutions because, by starting at zero rather
than 99, we exploit perl's default (undef) variable
initialization, and so avoid costly explicit
initializations, such as a prohibitive six stroke
penalty for a leading <C>$n=99;</C>.
Moreover, we can shorten the plural inflection problem
from, say, <C>bottle."s"x!!$n</C> to
<C>bottle.$&</C>.
</P>
<P>
Sadly though, such an algorithm is not well-suited to:
<CODE>
eval lc pack(u,'source-string')x99
</CODE>
because it requires a terminating action outside the loop,
namely to print the string built inside the loop.
If you could find a short bottle golf algorithm
that just did the same thing 99 times without
requiring anything at the beginning or end,
that could be a winner.
</P>
<P>
Unable to find such an algorithm,
I resorted to printing the value returned
by the eval like so:
<CODE>
print eval lc pack(u,'source-string')x99
</CODE>
Now, since <C>eval</C> returns the value of the last
expression, we just have to make sure that
its last evaluated expression
returns a complete 99 bottles of beer string;
for example, this 167-stroker:
<CODE>
@j=/s/?(take,one,down,an.d,pass,it,around):(go,to,the,store,an.d,buy,some,more);@m=(@z=(++$n,bottle.$&,of,beer),on,the,wall);s/^/,$"@m.\n\n@m,$"@z.\n\u@j/;/\n+/;$'.$`;
</CODE>
which can be tested like so:
<CODE>
print eval q!@j=/s/?(take,one,down,an.d,pass,it,around):(go,to,the,store,an.d,buy,some,more);@m=(@z=(++$n,bottle.$&,of,beer),on,the,wall);s/^/,$"@m.\n\n@m,$"@z.\n\u@j/;/\n+/;$'.$`;!x99
</CODE>
If you compare this code to our original algorithm,
you will notice that we are spared an <C>until</C> loop,
and the associated test for 99,
because we know we are executed 99 times via the eval.
That saves us 179 - 167 = 12 characters or so in the source string.
Yet those twelve source characters are reduced to nine
in the output string, courtesy of pack's 3/4 compression.
And, as you can see below:
<CODE>
eval lc pack u,'' [17]
print eval lc pack(u,'')x99 [27]
#23456789012345678901234567
</CODE>
this new way of employing pack is ten strokes longer.
That is, our nine stroke saving costs ten.
</P>
<P>
As proof of concept, running this program generates a working
157 stroke solution:
<CODE>
my $source = <<'PERSEVEROUS';
my@j=/s/?(take,one,down,$m,pass,it,around):(go,to,the,store,$
m=an.d,buy,some,more);@m=(@z=(++$n,bottle.$&,of,beer),on,the,
gall^v16);s/^/,$"@m.\n\n@m,$"@z.\n\u@j/;/\n+/;;$'.$`;
PERSEVEROUS
my $out = unpack 'u', uc($source);
open my $fh, '>', 'b.pl' or die "error: open b.pl: $!";
binmode $fh;
print $fh "print eval lc pack(u,q&" . $out . "&)x99";
</CODE>
Note that we (unluckily) lost a stroke because
a single quote was generated (near <C>"(g"</C> above),
necessitating packaging the string inside <C>q&..&</C>,
rather than <C>'...'</C>.
That is, this solution is potentially a 156 stroker.
So four strokes need to be whittled from the source
string to get down to 153 and another four to get to 150.
Since this looked unlikely, I reluctantly gave up on
this interesting approach.
</P>
<P><B>Translating outside the eval</B></P>
<P>
The following 152 stroke source string:
<CODE>
@m=(@z=(++$n,bottle.$&,of,beer),on,the,wall);s/^/s@m,v@z._/;s/s/\utakevonevdownvandvpassvitvaround,v@m.__/;"$'\ugovtovthevstorevandvbuyvsomevmore,v@m.";
</CODE>
which can be tested via:
<CODE>
my $prog = <<'PERSEVEROUS';
@m=(@z=(++$n,bottle.$&,of,beer),on,the,wall);s/^/s@m,v@z._/;s/s/\utakevonevdownvandvpassvitvaround,v@m.__/;"$'\ugovtovthevstorevandvbuyvsomevmore,v@m.";
PERSEVEROUS
s//lc $prog x99/ee;y/_v/
/;print
</CODE>
saves a whopping 179 - 152 = 27 characters
in the source string.
Yet those 27 source characters are reduced to about 20
in the output string, after pack's 3/4 compression.
And the cost of this form is a further 10 strokes,
as indicated below:
<CODE>
eval lc pack u,'' [17]
print eval lc pack(u,'')x99 [27]
s//lc pack(u,'')x99/ee;y/v_/ N/;print [37] (N represents newline)
#234567890123456789012345678901234567
</CODE>
That is, our 20 stroke saving comes at a cost of ... 20 strokes!
So I suppose this approach has a chance.
However, I found it very difficult to pour
this program into any "pack u" shape.
So I reluctantly gave up on this interesting approach too.
</P>
<P>
More radical still is this 148 stroker:
<CODE>
@m=(@z=(++$n,bottle.$&,of,beer),on,the,wall);s/^/s@m,`@z._/;s/s/]ake`one`down`and`pass`it`around,`@m.__/;"$'^o`to`the`store`and`buy`some`more,`@m.";
</CODE>
which can be tested via:
<CODE>
my $prog = <<'PERSEVEROUS';
@m=(@z=(++$n,bottle.$&,of,beer),on,the,wall);s/^/s@m,`@z._/;s/s/]ake`one`down`and`pass`it`around,`@m.__/;"$'^o`to`the`store`and`buy`some`more,`@m.";
PERSEVEROUS
s//lc $prog x99/ee;y/]-`/TG
/;print
</CODE>
This time 179 - 148 = 31 characters are saved in the source string.
And those 31 source characters are reduced to about 23
in the output string, after pack's 3/4 compression.
Note that the cost of this form is about 23 strokes,
as indicated below:
<CODE>
eval lc pack u,'' [17]
s//lc pack(u,'')x99/ee;y/v_/ N/;print [37]
s//lc pack(u,'')x99/ee;y/]-`/TGN /;print [40]
#234567890123456789012345678901234567890
</CODE>
Once again though, I found pouring this program
into any "pack u" shape problematic.
</P>
<P><B>Back to the main game</B></P>
<P>
After that interesting, if unsuccessful, diversion,
I reverted back to the main game, namely:
<CODE>
eval lc pack u,'source-string'
</CODE>
</P>
<P>
I felt that the best chance of getting from 154 to 151 was
to change "pack u54" to "pack u", a saving of
two strokes, combined with a one-stroke saving via
the tactical trick of
finding an algorithm ending in <C>$`</C>,
thus exploiting pack's use of backtick as the NULL byte.
With that approach, I don't need to find a significantly
shorter solution, just one that fits the default
"pack u" shape like a glove.
</P>
<P><B>Fun with split</B></P>
<P>
I was able to reduce my shortest unformatted solution from
179 strokes to 176 by exploiting a deprecated feature
of the Perl <C>split</C> function:
<CODE>
s/^/,$"@m.\n\n@m,$"@z.\n\u@_/,/s/until/99/*split@m=(@z=(++$n,bottle.$&,of,beer),on,the,wall),/\n+/?take7one7down7and7pass7it7around:go7to7the7store7and7buy7some7more;print$'.$`
# or
s/^/,$"@m.\n\n@m,$"@z.\n\u@_/until/99/*split@m=(@z=(++$n,bottle."s"x/\n+/,of,beer),on,the,wall),$&?take7one7down7and7pass7it7around:go7to7the7store7and7buy7some7more;print$'.$`
</CODE>
namely that calling <C>split</C> in scalar context has the
side-effect of setting <C>@_</C>. As an aside, note that
side-effects are frequently very useful in golf.
Though this solution only works with Perl 5.10 or earlier
(this mis-feature was thankfully (for non-golfers) removed in Perl 5.12)
that was ok for this game because
<a href="http://codegolf.com/">codegolf</a> competitions
use perl 5.8.8.
</P>
<P>
This shorter raw solution didn't help very much because
I was unable to effectively pour it into a "pack u" shape.
Just like my earlier 154-stroke entry, I had more success
by focusing on finding an algorithm to fit the required shape.
</P>
<P><B>Constraints</B></P>
<P>
<blockquote>
<P>
<I>
The more constraints one imposes, the more one frees oneself
of the chains that shackle the spirit... the arbitrariness of
the constraint only serves to obtain precision of execution.
</I>
</P>
<P align="right">
<small>-- Igor Stravinsky, 1882-1971</small>
</P>
</blockquote>
</P>
<P>
Stravinsky's inspirational quote notwithstanding,
I found the arbitrary constraint of fitting Perl code
into three lines of precisely 61 characters
in length, all starting with the letter "m",
to be frustrating in the extreme.
For example, I found many "nearly" solutions, such as:
<CODE>
# 1 2 3 4 5 6
#234567890123456789012345678901234567890123456789012345678901
mx;s//,$"@m.\n\n@m,$"@z.\n\u@_/until/^99.+/sm/split@m=(@z=(++$
m,bottle."s"x@-,of,beer),on,the,wall),@-?take7one7down7and.@
m.pass7it7around:go7to7the7store7and7buy7some7more;print$&.$`
</CODE>
which has line lengths of 62, 60, 61 when I need them to be
61, 61, 61. Aargh!?!!
Other "nearly" solutions were:
<CODE>
# 1 2 3 4 5 6
#234567890123456789012345678901234567890123456789012345678901
mx;s//$"@m.\n\n@m,$"@z.\n\u@_,/until/^(?=99)/m/split@m=(@z=($
m+=1,bottle."s"x@+,of,beer),on,the,wall),@+?take7one7down7and.@
m.pass7it7around:go7to7the7store7and7buy7some7more;print$',$`
mx;s/^/,$"@l.\n\n@l,$"@m.\n\u@_/,/s/until/^99.*/sm/split@l=(@
m=(++$n,bottle.$&,of,beer),on,the,wall),@+?take7one7down7and.@
l.pass7it7around:go7to7the7store7and7buy7some7more;print$&.$`
</CODE>
I was getting more and more frustrated ... and more
and more annoyed at that ugly leading "mx;".
</P>
<P><B>If only...</B></P>
<P>
So many "nearly" solutions.
If only one little thing was different, they'd work.
</P>
<P>
<blockquote>
<P>
<I>
If only, if only ... if only me auntie had bollocks she'd be me uncle
</I>
</P>
<P align="right">
<small>
-- <a href="http://www.youtube.com/watch?v=0VNFi1DLGHE">David Brent, The Office Season 2, Episode 3</a>
</small>
</P>
</blockquote>
</P>
<P>
Eventually, unable to bear looking at that damned leading "mx;"
any longer, I switched to seeking out solutions
beginning with <C>m/s/</C>. Well, that was (and remains)
the only half-way useful regex I can think of to start
a solution with.
After doing that, I finally found a perfectly fitting
152-stroke solution:
<CODE>
# 1 2 3 4 5 6
#234567890123456789012345678901234567890123456789012345678901
m/s/,@m=(@z=(++$n,bottle.$&,of,beer),on,the,wall),s/^/$"@m.\n
m@m,$"@z.\n\u@j,/while@j=!s/m//?(go,to,the,store,an.d,buy,so.
me,more):(take,one,down,an.d,pass,it,around),$n^99;print$'.$`
</CODE>
Yay!
The remarkable and non-obvious tactical trick of inserting
the "m" length byte into the string -- then
later removing it (via <C>s/m//</C>),
with the side-effect of usefully
setting <C>$'</C> and <C>$`</C> -- I would never have
found were it not for the constraints
of having to start the first line with <C>m/s/</C>
and having to break it after exactly 61 bytes.
</P>
<P>
As shown [id://997591|last time], we need to generate a
working 152-stroke entry via a little program, such as:
<CODE>
my $source = <<'PERSEVEROUS';
m/s/,@m=(@z=(++$n,bottle.$&,of,beer),on,the,wall),s/^/$"@m.\n
m@m,$"@z.\n\u@j,/while@j=!s/m//?(go,to,the,store,an.d,buy,so.
me,more):(take,one,down,an.d,pass,it,around),$n^99;print$'.$`
PERSEVEROUS
my $out = unpack 'u', uc($source);
open my $fh, '>', 'b.pl' or die "error: open b.pl: $!";
binmode $fh;
print $fh "eval lc pack u,'" . $out . "'";
</CODE>
</P>
<P>
Despite ending with the desired backtick,
this solution cannot be reduced to 151 because it relies
on the last line starting with the letter "m", the length
byte for 61. To get to 151, we need to start the last line
with the letter "l", the length byte for 60.
</P>
<P>
Reverting to the deprecated perl split semantics,
I found a number of 151-stroke solutions
whose last line begins with the letter "l":
<CODE>
# 1 2 3 4 5 6
#234567890123456789012345678901234567890123456789012345678901
m/s/,@m=(@z=(++$n,bottle.$&,of,beer),on,the,wall),s/^/$"@m.\n
m@m,$"@z.\n\u@_,/until/99/*split+"l",s/m//?takeloneldownland.
lpasslitlaround:goltolthelstorelandlbuylsomelmore;;print$'.$`
m/s/,@m=(@z=($".++$n,bottle.$&,of,beer),on,the,wall),s/^/,@m.
m@m,@z.\n\u@_/until/99/*split+"l",s/m./\n/?takeloneldownland.
lpasslitlaround:goltolthelstorelandlbuylsomelmore;;print$'.$`
m/s/,@m=(@z=(",",++$n,bottle.$&,of,beer),on,the,wall),s/^/@m.
m@m@z.\n\u@_/until/99/*split+"l",s/m../\n/?takeloneldownland.
lpasslitlaround:goltolthelstorelandlbuylsomelmore;;print$'.$`
</CODE>
</P>
<P>
After submitting one of these to tie for the lead
I felt I could finally relax ...
until the tenacious "dmd" struck back yet again,
posting a 149-stroke solution!
</P>
<P><B>Complexity</B></P>
<P>
I hope I've been able to convey the extra level of complexity
that compression adds to golf. As if the game of golf
were not already hard enough.
To illustrate that extra level of complexity, I quote leading
Python golfer hallvabo again:
<blockquote>
<I>
This reminds of the SHA-256 challenge on codegolf.com.
Since Python's built-in compression wasn't available and my source
code was over 500 bytes long, I figured I had to roll my own
compression scheme to beat Mark Byers leading the Python section with
493 strokes. I started with restricting the source to 64 characters so
I could use a homemade 6-bit character encoding (curiously, this only
increased the source from 507 to 512 bytes! this was because I couldn't
use ~, so tricks like ~- became unavailable). I then golfed the
decompressor, getting it down to about 75 strokes. Finally, I
recognized that this approach gives a whole set of new tricks to play
with, since I could reuse variables from the decompression stage in the
sha-256 stage! Of course, this requires the variables to have the
correct value after the decompression stage... at this point my brain
almost melted :)
</I>
</blockquote>
</P>
<P>
That concludes this introductory series
on the difficult topic of compression in golf.
I hope you've enjoyed it.
If you are looking for further challenges, we know
those damned beer bottles can be further reduced to 149,
perhaps lower.
Though be warned, the complexity of this task may melt your brain. :)
</P>
<P><B>References</B></P>
<P>
<ul>
<li> [id://995190]
<li> [id://997591]
<li> <a href="http://terje2.frox25.no-ip.org/~golf-info/Book.html">Terje/mtv pdf book of Perl Golf</a>
<li> [id://811919]
<li> [id://903641]
</ul>
</P>
<P>
</P>
<P>
<small>
<I>
Acknowledgement: I'd like to thank [mtve] and hallvabo for their help in preparing this series.
</I>
</small>
</P>