Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Replaying Santa Claus Golf Apocalypse with Pugs/Perl6

by eyepopslikeamosquito (Canon)
on Mar 12, 2005 at 05:03 UTC ( #438876=perlmeditation: print w/ replies, xml ) Need Help??

For cheap thrills, I decided to have a go at replaying the original Santa Claus Golf Apocalypse with Pugs/Perl6. This note tells of my experiences attempting that.

Getting started with Pugs was a pleasingly simple two step process:

For more details on Pugs, go to pugscode.org.

All installed fine. Beauty. Now to write my first Perl 6 program, hello.p6:

say "Hello World!";
In bewildered awe and with shaking fingers, I entered:
pugs hello.p6
and back flashed the response:
Hello World!
Woo hoo! Now to work.

Please don't laugh at my original test program, tsanta.pl, written over three years ago. I decided to leave it alone in Perl 5 for now, just making the minor adjustment of running each golf hole with pugs rather than perl and changing the names of the programs from head.pl to head.p6 and so on. Maybe I'll try rewriting this test program in Perl 6 later. Update: The p6 rewrite, tsanta.p6, was done in Pugs Baby Steps; for latest versions of tsanta.p6 and rg0now's excellent solutions below see examples/golf in the Pugs distribution. Here is the updated tsanta.pl:

# tsanta.pl. Santa Claus golf game test program. use strict; sub GolfScore { my $script = shift; open(FF, $script) or die "error: open '$script'"; my $golf = 0; while (<FF>) { chomp; next unless length; s/^#!.*?perl// if $. == 1; $golf += length; } close(FF); return $golf; } sub PrintGolfScore { my @scr = @_; my $tot = 0; for my $s (@scr) { $tot += GolfScore($s) } print "You shot a round of $tot strokes.\n"; } sub BuildFile { my ($fname, $data) = @_; open(FF, '>'.$fname) or die "error: open '$fname'"; print FF $data; close(FF); } sub CheckOne { my ($scr, $label, $data, $exp) = @_; my $intmp = 'in.tmp'; BuildFile($intmp, $data); my $cmd = "pugs $scr $intmp"; print "$label: running: '$cmd'..."; my $out = `$cmd`; my $rc = $? >> 8; print "done (rc=$rc).\n"; if ($out ne $exp) { warn "Expected:\n"; print STDERR $exp; warn "Got:\n"; print STDERR $out; die "Oops, you failed.\n"; } } # ----------------------------------------------------- my $file1 = <<'GROK'; 1st line GROK my $file2 = <<'GROK'; 1st line 2nd line GROK my $file3 = <<'GROK'; 1st line 2nd line 3rd line GROK my $file4 = <<'GROK'; 1st line 2nd line 3rd line 4th line GROK my $file12 = <<'GROK'; 1st line 2nd line 3rd line 4th line 5th line 6th line 7th line 8th line 9th line 10th line 11th line 12th line GROK my $file21 = <<'GROK'; 1st line 2nd line 3rd line 4th line 5th line 6th line 7th line 8th line 9th line 10th line 11th line 12th line GROK # ----------------------------------------------------- sub CheckHead { my ($scr) = @_; my @tt = ( [ 'file1', $file1, "1st line\n" ], [ 'file2', $file2, "1st line\n2nd line\n" ], [ 'file3', $file3, "1st line\n2nd line\n3rd line\n" ], [ 'file12', $file12, "1st line\n2nd line\n3rd line\n4th line\n5th line\n". "6th line\n7th line\n8th line\n9th line\n10th line\n" ], ); for my $r (@tt) { CheckOne($scr, $r->[0], $r->[1], $r->[2]) } } sub CheckTail { my ($scr) = @_; my @tt = ( [ 'file1', $file1, "1st line\n" ], [ 'file2', $file2, "1st line\n2nd line\n" ], [ 'file3', $file3, "1st line\n2nd line\n3rd line\n" ], [ 'file12', $file12, "3rd line\n4th line\n5th line\n6th line\n7th line\n". "8th line\n9th line\n10th line\n11th line\n12th line\n" ], [ 'file21', $file21, "12th line\n\n\n\n\n\n\n\n\n\n" ], ); for my $r (@tt) { CheckOne($scr, $r->[0], $r->[1], $r->[2]) } } sub CheckRev { my ($scr) = @_; my @tt = ( [ 'file1', $file1, "1st line\n" ], [ 'file2', $file2, "2nd line\n1st line\n" ], [ 'file3', $file3, "3rd line\n2nd line\n1st line\n" ], [ 'file21', $file21, "\n\n\n\n\n\n\n\n\n12th line\n11th line\n10th line\n". "9th line\n8th line\n7th line\n6th line\n5th line\n". "4th line\n3rd line\n2nd line\n1st line\n" ], ); for my $r (@tt) { CheckOne($scr, $r->[0], $r->[1], $r->[2]) } } sub CheckMid { my ($scr) = @_; my @tt = ( [ 'file1', $file1, "1st line\n" ], [ 'file2', $file2, "1st line\n2nd line\n" ], [ 'file3', $file3, "2nd line\n" ], [ 'file4', $file4, "2nd line\n3rd line\n" ], [ 'file12', $file12, "6th line\n7th line\n" ], [ 'file21', $file21, "11th line\n" ], ); for my $r (@tt) { CheckOne($scr, $r->[0], $r->[1], $r->[2]) } } sub CheckWc { my ($scr) = @_; my @tt = ( [ 'file1', $file1, "0000000001\n" ], [ 'file2', $file2, "0000000002\n" ], [ 'file3', $file3, "0000000003\n" ], [ 'file4', $file4, "0000000004\n" ], [ 'file12', $file12, "0000000012\n" ], [ 'file21', $file21, "0000000021\n" ], ); for my $r (@tt) { CheckOne($scr, $r->[0], $r->[1], $r->[2]) } } # ----------------------------------------------------- my $head = 'head.p6'; my $tail = 'tail.p6'; my $rev = 'rev.p6'; my $mid = 'mid.p6'; my $wc = 'wc.p6'; select(STDERR);$|=1;select(STDOUT);$|=1; # auto-flush -f $head or die "error: file '$head' not found.\n"; -f $tail or die "error: file '$tail' not found.\n"; -f $rev or die "error: file '$rev' not found.\n"; -f $mid or die "error: file '$mid' not found.\n"; -f $wc or die "error: file '$wc' not found.\n"; PrintGolfScore($head, $tail, $rev, $mid, $wc); CheckHead($head); CheckTail($tail); CheckRev($rev); CheckMid($mid); CheckWc($wc); PrintGolfScore($head, $tail, $rev, $mid, $wc); print "Hooray, you passed.\n";

With that ugly chore out of the way, time to set about writing Perl 6 versions of each hole.

I started with Eugene's winning Perl 5 solutions from 2001, namely:

*** Eugene van der Pijll: 89 (11 19 13 25 21) *** --- head.pl --------------------------------------------- #!/usr/bin/perl -p 11..exit --- tail.pl --------------------------------------------- print+(<>)[-10..-1] --- rev.pl --------------------------------------------- #!/usr/bin/perl -p $\=$_.$\}{ --- mid.pl --------------------------------------------- #!/usr/bin/perl -p0 $_=$1while/.^(.+)^/ms --- wc.pl --------------------------------------------- printf"%010d\n",$.,<>

Now this is where I hit a bit of trouble as it dawned on me I had no idea how to write Perl 6 code. I further had no clue what parts of Perl 6 the scintillating autrijus had got around to implementing yet. Never fear, browse around the Pugs test suite a bit (while singing a song in praise of test-driven development) and grep for favourite functions, such as substr (nuts, not there), join (yep), elems (nuts again), reverse (oh dear), ...

Anyway, after a few hours of random hackery, I am the proud owner of five Pugs Perl 6 programs that pass the tsanta.pl test program. Here they are:

--- head.p6 --------------------------------------------- my$h=open@ARGS[0];print(($h.readline())[0..9]) --- tail.p6 --------------------------------------------- my$h=open@ARGS[0];my@l=$h.readline(); my$i;for(@l){++$i} $i=$i-10;$i=0 if$i<0; print@l[$i..Inf] --- rev.p6 --------------------------------------------- my$h=open@ARGS[0];my@l=$h.readline(); my$x;for(@l){$x=$_~$x} print$x; --- mid.p6 --------------------------------------------- # Note: works for Pugs 6.0.10 but will require removal # of -0.1 below for Pugs 6.0.11. my$h=open@ARGS[0];my@l=$h.readline(); my$i;for(@l){++$i} print@l[int(($i-1)/2-0.1)..int($i/2-0.1)] --- wc.p6 --------------------------------------------- my$h=open@ARGS[0];my@l=$h.readline(); my$i;for(@l){++$i} say join"",(split"",int(7e10+$i))[1..Inf];

Please note that these are not examples of good Perl 6 style -- quite the reverse actually, since I have no clue what I'm doing. Perl 6 experts, therefore, are invited to write much improved versions. In writing mid.p6, I noticed that int truncates in Perl 5 yet rounds in Pugs. Bug or feature? Update: It's a fixed bug (see autrijus journal) -- I was using Pugs 6.0.10 and version 6.0.11, due out in a couple of days, will include this truncate fix, which in turn will require a minor adjustment to mid.p6 (remove the silly -0.1 I think). Oh, and the lack of printf made wc.p6 a real pest to write.

Running: perl tsanta.pl produced:

You shot a round of 398 strokes. file1: running: 'pugs head.p6 in.tmp'...done (rc=0). file2: running: 'pugs head.p6 in.tmp'...done (rc=0). file3: running: 'pugs head.p6 in.tmp'...done (rc=0). file12: running: 'pugs head.p6 in.tmp'...done (rc=0). file1: running: 'pugs tail.p6 in.tmp'...done (rc=0). file2: running: 'pugs tail.p6 in.tmp'...done (rc=0). file3: running: 'pugs tail.p6 in.tmp'...done (rc=0). file12: running: 'pugs tail.p6 in.tmp'...done (rc=0). file21: running: 'pugs tail.p6 in.tmp'...done (rc=0). file1: running: 'pugs rev.p6 in.tmp'...done (rc=0). file2: running: 'pugs rev.p6 in.tmp'...done (rc=0). file3: running: 'pugs rev.p6 in.tmp'...done (rc=0). file21: running: 'pugs rev.p6 in.tmp'...done (rc=0). file1: running: 'pugs mid.p6 in.tmp'...done (rc=0). file2: running: 'pugs mid.p6 in.tmp'...done (rc=0). file3: running: 'pugs mid.p6 in.tmp'...done (rc=0). file4: running: 'pugs mid.p6 in.tmp'...done (rc=0). file12: running: 'pugs mid.p6 in.tmp'...done (rc=0). file21: running: 'pugs mid.p6 in.tmp'...done (rc=0). file1: running: 'pugs wc.p6 in.tmp'...done (rc=0). file2: running: 'pugs wc.p6 in.tmp'...done (rc=0). file3: running: 'pugs wc.p6 in.tmp'...done (rc=0). file4: running: 'pugs wc.p6 in.tmp'...done (rc=0). file12: running: 'pugs wc.p6 in.tmp'...done (rc=0). file21: running: 'pugs wc.p6 in.tmp'...done (rc=0). You shot a round of 398 strokes. Hooray, you passed.

Of course, everyone is invited to beat my pathetic score of 398 strokes and there are two ways to do this: download Pugs and write versions that pass the probing tsanta.pl test program; and (for Perl 6 gurus only) devise theoretically correct Perl 6 solutions that are not yet implemented in Pugs. Enjoy!

Comment on Replaying Santa Claus Golf Apocalypse with Pugs/Perl6
Select or Download Code
Re: Replaying Santa Claus Golf Apocalypse with Pugs/Perl6
by audreyt (Hermit) on Mar 12, 2005 at 07:39 UTC
    Wow. This totally, totally made my day. I should dig up my past award-winning golfs and rewrite them in Perl 6 too... And make this a "golf-driven development" project. :-)

    Say, are you willing to become a committer in Pugs and commit those wonderful example scripts under examples/golf/*?

      Say, are you willing to become a committer in Pugs and commit those wonderful example scripts under examples/golf/*?
      Yes. I'd like to add some tests and stuff too. It's only fair to warn, however, that I don't have huge amounts of spare time and there is a steep learning curve for me, but I hope to get there eventually and contribute something useful for a change.

      Personally, I find it interesting to give Perl 6 a workout in writing very concise code. That said, I trust that playing golf (or writing poetry) is not part of the Perl 6 design team's design goals. ;-)

        Invitation sent. Welcome aboard!

        I think Perl 6 design team has a fair bit of interest in golf too... Only they call it huffman encoding. Otherwise how can you explain that $h.readline can be written as =$fh now?

Re: Replaying Santa Claus Golf Apocalypse with Pugs/Perl6
by rg0now (Chaplain) on Mar 12, 2005 at 15:35 UTC
    This is the best I could come up with for tail.p6:
    my@l=(open@ARGS[0]).readline(); my$i;$i=@l-10 if@l>10; say@l[$i..Inf];
    It seems to pass all tests for current Pugs svn build.

    Update: After discovering that the good old ternary operator was renamed to ?? ::, I came up with the slightly more elegant solution:

    my@l=(open@ARGS[0]).readline(); my$i=@l>10??@l-10::0; say@l[$i..Inf];
    This is exactly one character shorter...:-)

    Update2: I have just discovered the = $filehandle operator in list context, so, take this one:

    my@l= =open@ARGS[0]; my$i=@l>10??@l-10::0; say@l[$i..Inf];

    In fact, my@l==open@ARGS[0]; seems to work too, but, in my opinion, this should better be a bug...

    rg0now

      I don't know if it's implemented yet, but you should be able to make that last line:
      say@l[$i...];
      Combining with the previous line gets you
      say@l[(@l>9??@l-10::0)...];
      I took the liberty of changing your 10 to a 9. The final semicolon should not be required eventually either.
        I don't know if it's implemented yet, but you should be able to make that last line:
        say@l[$i...];

        Again, Pugs knows better...:-) It does not seem to work with the current svn build.

        say@l[(@l>9??@l-10::0)...];
        Yes, I tried similar solution myself, too, but Pugs does not let me to incorporate the ternary operator into the array index. What is pretty interesting playing around with Pugs is that usually it proves itself much more flexible in parsing complex Perl 6 statements than I would have expected it, but every now and then even the simplest ideas fail with some obscure error messages. It is getting better all the time, though.

        rg0now

Re: Replaying Santa Claus Golf Apocalypse with Pugs/Perl6
by rg0now (Chaplain) on Mar 12, 2005 at 16:22 UTC
    And here is my strike at rev.p6

    my@l=(open@ARGS[0]).readline(); for(@l){print pop(@l)}

    Update: using the  = $filehandle operator in list context, this boils down to:

    my@l==open@ARGS[0]; for(@l){print pop(@l)}

    rg0now

      I would consider it a bug that == can be parsed as = =, so you shouldn't depend on that. On the other hand, the for will not require parens, though it will require a space before the opening bracket. And @l.pop would be shorter than the function form. Then again, you eventually ought to be able to do the whole thing with
      print reverse=<>;
        You are absolutely right just about everything, you wrote, except that when golfing with Pugs, you must take into account that many things will not work as expected, or will not work at all...:-)

        For example, Pugs does not have reverse yet. And while it seems to recognize the parenless form of for, it requires an extra space not just before the loop statement, but immedaitely after it, too. So, the code takes the form:

        my@l= =open@ARGS[0]; for @l {print @l.pop}
        And this is just as long as the form with parens, but less clean.

        However, the more I see the @l.pop form, the more I like it. Thank you for pointing this out to me...

        Update: I was stupid, parenless for is working just right, as TimToady suggested, I don't know, what the hell I was messing up...:-)

        rg0now

        Indeed, and that bugs is closed, so 6.0.11 won't parse it as = =. On the other hand, :==$x stays legal and is parsed as := =$x in the absense of an user-defined :== operator, which I think is correct -- let me know if it's not. :)

        The for@l {...} form is indeed correctly parsed; no whitespace is needed before @.

        Finally, thanks to this Golf-Driven Development, nothingmuch is now implementing reverse as we speak, so 6.0.11 should be happy with print reverse=<> -- note that I shaved the trailing semicolon. Yay!

Re: Replaying Santa Claus Golf Apocalypse with Pugs/Perl6
by rg0now (Chaplain) on Mar 12, 2005 at 17:55 UTC
    And here is my masterpiece for today, wc.p6:
    say*(split"",int(7e10+ +*(=open@ARGS[0])))[1..11]
    Just a quick explanation about +*(=open@ARGS[0]): the * operator forces the = $filehandle operator into list context, which is then forced into scalar context to count the number of lines in the file. Similar idea is used right after say, to force the ourput of split[] into list context without the use of join.

    Update: And of course, head.p6 along similar lines:

    print*(=open@ARGS[0])[0..9]

    rg0now

Re: Replaying Santa Claus Golf Apocalypse with Pugs/Perl6
by rg0now (Chaplain) on Mar 12, 2005 at 19:42 UTC
    After updating to the most current Pugs and incorporating all the ideas above, here is my final strike on the Santa Claus Perl6/Pugs Golf Apocalypse:
    --- head.p6 --------------------------------------------- print*(=open@ARGS[0])[0..9] --- tail.p6 --------------------------------------------- my@l= =open@ARGS[0]; print@l[(@l>9??@l-10::0)...] --- rev.p6 --------------------------------------------- print reverse=open@ARGS[0] --- mid.p6 --------------------------------------------- my@l= =open@ARGS[0]; print@l[int((@l-1)/2)..int(@l/2)] --- wc.p6 --------------------------------------------- say*(split"",int(7e10+ +*(=open@ARGS[0])))[1..11]
    It is all but nice but is is actually only 203 strokes...:-)

    rg0now

      Hey, why =open@ARGV[0] instead of =<> again? That will save 10 strokes per hole, bringing it to a more respectable 153...
        This is because we are ran by
        my $cmd = "pugs $scr $intmp";
        which means that we are getting the name of the file to be read as the first command line argument. But, based on my (granted, limited) understanding, =<> would read from the standard input. Am I completely missing something here again?

        rg0now

      Can open take a block yet?
      open@ARGS[0]{print..11}
      or is open ... {...} a figment of my imagination?
        Quite a strange syntax, I think. And apparently, Pugs thinks so too, because it croaks badly when I try to run your version.

        Even though, the fact that neither Pugs nor me seem to recognize this syntax, this does not mean to any extent that it is illegal. If you can recall where you met it, I can definitely make a todo_test out of it for autrijus to implement...

        rg0now

This one goes for the archives
by rg0now (Chaplain) on Mar 17, 2005 at 19:51 UTC
    After many bugfixes that went to Pugs as the side-effect of this very nice contest, here is the final (now, really) version of my strike at the Santa Claus Golf Apocalypse with Pugs/Perl6 that is assumed to work with current Pugs:
    --- head.p6 --------------------------------------------- print*(=<>)[0..9] --- tail.p6 --------------------------------------------- my@l= =<>; print@l[(@l>9??@l-10::0)...] --- rev.p6 --------------------------------------------- print reverse=<> --- mid.p6 --------------------------------------------- my@l= =<>; print@l[int((@l-1)/2)..int(@l/2)] --- wc.p6 --------------------------------------------- say*(split"",int(7e10+ +*(=<>)))[1..11]
    This is only 153 strokes, but I am entirely convinced that you can do it by less work... Go figure!

    rg0now

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://438876]
Approved by thor
Front-paged by gmax
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (9)
As of 2014-09-22 06:24 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (182 votes), past polls