gmane.comp.lang.perl.qotw.discuss

[QUIZ] Perl 'Hard' Quiz of the Whatever #2008-03-28 - Solving Kakuro

Shlomi Fish — 2008-03-27T22:38:08

IMPORTANT: Please do not post solutions, hints, or other spoilers until at least 60 hours after the date of this message. Thanks. Kakuro (a.k.a Cross-sums) is a kind of puzzle game: http://en.wikipedia.org/wiki/Kakuro In it, one fills in squares in a crossword-like grid that sum to their sums. One can fill in the digits from 1 to 9, and no digit can be repeated twice. Your object is that given a Kakuro board in a text format described below, then output the final solution. You can find some sample layouts from kakuro.com here: http://www.shlomifish.org/Files/files/text/kakuro.com-layouts/ and there's a new daily puzzle everyday there. (Requires Flash) There are also some more layouts googleable or on the wikipedia page. The layout has the following format: 1. It consists of $Height lines. 2. Each line has $Width squares. Whitespace inside each line is ignored. 3. Each square starts with [ and ends with ]. 4. A square that contains a \ is a blocked square (i.e: a square that cannot have any

Re: [QUIZ] Perl 'Medium' Quiz of the Whatever #2008-02-28 - Kakuro Digit Sums

Martijn Lievaart — 2008-03-07T08:34:14

[ Haven't got the original mail, so piggying here ] "Any programming problem can be solved by adding another layer of indirection". Here's my solution. Run this program to produce a program which satisfies the requirements. I also expect this solution to be the fastest around.... :-) Regards, M4 #!/usr/bin/perl use strict; use warnings; sub get_digits_sum { my ($sum, $num_places) = < at >_; return [solve($sum, $num_places, 0, 0)]; } sub solve { my ($sum, $places_left, $running, $previous, < at >partial) = < at >_; return map solve($sum, $places_left-1, $running+$_, $_, < at >partial, $_), ($previous+1..($sum - $running > 9 ? 9 : $sum - $running)) if $places_left; return $sum == $running ? [< at >partial] : (); } print <<'EOT'; #!/usr/bin/perl use strict; use warnings; use Test::More tests => 8; my %sol = ( EOT use Data::Dumper; for my $sum (1..45) { print "$sum => {\n"; for my $places (1..9) { my $answer = get_digits_sum($sum, $places); if (< at >$answer) { print " $places => \n";

Re: [QUIZ] Perl 'Medium' Quiz of the Whatever #2008-02-28 - Kakuro Digit Sums

Greg Bacon — 2008-03-06T14:44:52

In Haskell, FWIW: get_digits_sum _ 0 = [] get_digits_sum 0 _ = [] get_digits_sum goal n = find goal n [1..9] where find _ _ [] = [] find goal n (d:ds) | n == 1 && d == goal = [[d]] | otherwise = with ++ find goal n ds where with = map (d:) $ find (goal - d) (n - 1) ds Greg

Re: [QUIZ] Perl 'Medium' Quiz of the Whatever #2008-02-28 - Kakuro Digit Sums

2008-03-06T10:05:11

Here's my solution. It, too, is recursive, but unlike M. Fish's, I've used a secondary accumulator parameter. -- michael. -- #!perl use strict; sub get_digits_sum { my ($sum, $left, $soln, < at >ns) = < at >_; return if $sum == 0; return [get_digits_sum($sum, $left, [], 1..9)] if !defined $soln; return (grep {$sum==$_} < at >ns) ? [< at >$soln, $sum] : () if $left == 1; my < at >rv; for my $n (< at >ns) { return < at >rv if $n > $sum; # rest won't work either push < at >rv, get_digits_sum($sum-$n, $left-1, [< at >$soln, $n], ($n+1)..9); } return < at >rv; } my ($sum, $places) = < at >ARGV; my $rv = get_digits_sum($sum, $places); print join " ", < at >$_, "\n" for < at >$rv;

Re: [QUIZ] Perl 'Medium' Quiz of the Whatever #2008-02-28 - KakuroDigit Sums

Premysl Anydot Hruby — 2008-03-03T17:25:03

my recursive solution: 8<----8< #!/usr/bin/perl use warnings; use strict; use Data::Dumper; sub get_digits_sum { my ($sum, $num, $start) = < at >_; my $max = ($sum < 10 ? $sum : 9); $start = 1 unless $start; return [] unless $num; return [] if $sum <= 0; return [] if $max < $start; return [[$sum]] if $num == 1; my < at >result; for my $current ($start..$max) { push < at >result, map [$current, < at >$_], < at >{get_digits_sum($sum - $current, $num - 1, $current + 1)}; } return \< at >result; } die ("run with sum and number of cell's") unless < at >ARGV == 2; print Dumper(get_digits_sum(< at >ARGV)); 8<----8<

Re: [QUIZ] Perl 'Medium' Quiz of the Whatever #2008-02-28 - Kakuro Digit Sums

Shlomi Fish — 2008-03-03T15:04:36

Here is my solution, which is recursive: <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< use strict; use warnings; use Test::More tests => 5; my $max_digit = 9; my $min_digit = 1; sub _digits_sum_from { my ($start, $sum, $num_places) = < at >_; if ($num_places == 1) { if (($sum >= $start) && ($sum <= $max_digit)) { return [[$sum]]; } else { return []; } } my < at >results; FIRST_LOOP: foreach my $first ($start .. $max_digit) { if ($sum-$first <= 0) { last FIRST_LOOP; } push < at >results, (map { [$first,< at >$_] } < at >{_digits_sum_from($first+1, $sum-$first, $num_places-1)} ); } return \< at >results; } sub get_digits_sum { my ($sum, $num_places) = < at >_; return _digits_sum_from($min_digit, $sum, $num_places); } # TEST is_deeply(get_digits_sum(3,2), [[1,2]], "3 over 2"); # TEST is_deeply(get_digits_sum(7,3), [[

Re: [QUIZ] Perl 'Hard' Quiz of the Whatever #2008-12-28 - Symmetric Sokoban

Ron Isaacson — 2008-01-06T04:17:12

Oops, and I found a bug in that logic. It's not just an optimization; some kind of state cache is necessary to avoid just pushing the same block back and forth forever. However, the cache currently ignores the position of the player. THAT is an optimization; given these two boards: A) ####### B) ####### # # # # # $ $ # # $ # # ### # $ ### # ..# # ..# ######### ######### There are multiple sets of pushes that will get you from A to B, and no reason to try more than one set that gets you to the same result. No matter where the player is once you've entered state B, the possible future moves from there are all the same. HOWEVER, if you take blocking into account: C) ##### D) ##### # # # # # #$# # #$# # # ### # # ### # $< at >..# #< at >$ ..# ####### ####### States C and D are NOT equivalent -- one is solvable, and one isn't! So if you ignore the position of the player entirely

Re: [QUIZ] Perl 'Hard' Quiz of the Whatever #2008-12-28 - Symmetric Sokoban

Ron Isaacson — 2008-01-06T02:47:10

[NB: Sorry if anyone is getting multiple copies of this. The mail server seems to keep rejecting my mail due to attachment content type, so the program is now included in the message.] Jurgen Pletinckx wrote: Same here, on both counts. :-) I just finished mine, and haven't looked at either of the two posted solutions yet, so I'm not sure how they compare. My general approach is pretty simple: - Find all valid pushes from the current spot - For each push: - Do it - Recurse - If the puzzle is solved, exit - Undo it The puzzle is always stored and used as a list of lists, with $puzzle->[$row]->[$col] containing the actual ASCII character, and it's never converted into any other representation. Nor is it ever rotated or transformed in any other way (other than making moves & then reversing them). The "find all valid pushes" piece was easier than I originally made it out to be. I eventually settled on a non-recursive version of the "flood fill" algorithm to radiate outward from t

Re: [QUIZ] Perl 'Hard' Quiz of the Whatever #2008-12-28 - Symmetric Sokoban

Shlomi Fish — 2008-01-04T17:13:16

Hi all! OK, my complete solution to the QOTW can be found here: http://www.shlomifish.org/Files/files/code/perl/qotw/Shlomif-Sokoban-Solver-0.01.tar.gz It includes some tests (though, not for the solving algorithm itself), a module and some tests. My scheme was: 1. Store the board as a vector of 2-bits, and the states as 2 bits (locations of the boxes and the space accessible to the player). vec() was used for the bit-fiddling. 2. Make use of the symmetry by only storing and looking up the least-valued rotated board. This makes it unsuitable for general Sokoban solutions, at least until I adapt the code to detect a possible symmetry. 3. Use a BFS search to find the solution, and a BFS search to find the accessible places for a player to go. ------------------ There's still room for many optimisations and many dead ends are not detected soon enough. The program runs in just under two minutes on my Mandriva Cooker system on a P4-2.4GHz machine. I'm including here the code of my main module

RE: [QUIZ] Perl 'Hard' Quiz of the Whatever #2008-12-28 - Symmetric Sokoban

Jurgen Pletinckx — 2008-01-04T14:44:15

Shlomi Fish public.gmane.org> mailed on 28 December 2007 12:31: | IMPORTANT: Please do not post solutions, hints, or other spoilers | until at least 60 hours after the date of this message. Thanks. | | I was told the "What does this code do?" quizzes were not as good as a new | programming task, so here's a more traditional QOTW that I came up with. In | this quiz you'll try to solve the following Sokoban ( | http://en.wikipedia.org/wiki/Sokoban ) puzzle using Perl: | | {{{{{{{{{{{{{{ | #### | # # | # #### | ###$.$ # | # .< at >. # | # $.$### | #### # | # # | #### | }}}}}}}}}}}}}} Well past the spoiler line now ... (I do prefer these tasks to "WDTCD?" quizzes. *And* I had some tuits over the holidays. Anyone else out there?) I've tried not to be too clever. * Standard breadth-first search, no heuristics * tree is stored in a hash, as child => parent pairs * sparse tree (I only record the fastest way to get to a state) * the text representati

[QUIZ] Perl 'Hard' Quiz of the Whatever #2008-12-28 - Symmetric Sokoban

Shlomi Fish — 2007-12-28T11:31:02

IMPORTANT: Please do not post solutions, hints, or other spoilers until at least 60 hours after the date of this message. Thanks. I was told the "What does this code do?" quizzes were not as good as a new programming task, so here's a more traditional QOTW that I came up with. In this quiz you'll try to solve the following Sokoban ( http://en.wikipedia.org/wiki/Sokoban ) puzzle using Perl: {{{{{{{{{{{{{{ #### # # # #### ###$.$ # # .< at >. # # $.$### #### # # # #### }}}}}}}}}}}}}} If you're not familiar with the notation, then "#" are walls, "$" are the initial positions of the boxes to be moved, "." are the destinations and "< at >" is the initial position of the player. This level is the Microban level No. 142 in the levels collection of KSokoban. You may want to solve it yourself before using Perl to do so. You can load it into a Sokoban clone by saving it into a file and then using the "load" command. Good luck and happy new year! Regards, Shlomi Fish -------------------------

[QUIZ] Perl 'What does this code do?' Quiz

Shlomi Fish — 2007-10-28T17:06:31

Hi all! Here's another "What does this code do?" Quiz. I obfuscated the names of the variable names to prevent hinting their purpose, but the code itself is not obfuscated. You have to guess what the "m2()" function does. Good luck! Please post spoilers as response to this post with "SPOILER". Regards, Shlomi Fish <<<<<<<<<<<<<<<<<<<<< use strict; use warnings; sub m2 { my $c = shift; my $d = sub { my $e = shift; return +(ref($e) eq "ARRAY") ? $e->[1] : $e; }; my $f = sub { my $e = shift; return +(ref($e) eq "ARRAY") ? $e->[0] : 1; }; my $g; $g = sub { my ($h, $i, $j) = < at >_; if (($h == < at >$c) && ($j == 0)) { return (); } elsif ($j == 0) { return $g->($h+1, $d->($c->[$h]), $f->($c->[$h]) ); } else { return ($i, $g->($h, $i, $j-1)); } }; return [ $g->(0, 0, 0) ]; } 1;

Re: [QUIZ] Perl 'What does this code do?' Quiz

Rob Kinyon — 2007-07-02T04:10:31

WALKMETH is a P6 thing (described in Apocalypse 12 http://dev.perl.org/perl6/doc/design/apo/A12.html) that generates a list of all methods that will respond to that invocation. My answer wasn't quite correct - the implementation of CALLALL described in A12 is the closer analog to the code provided. The "mostly complete" bit had to do with a few missing paranoia bits in the P5 as well as the fact that CALLALL does a take as opposed to executing the method right away (lazy vs. immediate). Personally, I prefer lazy evaluation as the default, but that's not really possible in P5 without breaking encapsulation or doing crazy things like Contextual::Return and the like that completely blow your runtime performance. Rob

Re: [QUIZ] Perl 'What does this code do?' Quiz

Greg Matheson — 2007-07-01T15:08:35

Is this the answer? DB<54> use Crypt::Rot13 DB<55> $c = Crypt::Rot13->new DB<56> $c->charge('xbmlnfui') DB<57> x $c->rot13(25) 0 'walkmeth' But I don't know what 'walkmeth' is.

Re: SPOILER: 'What does this code do?' Quiz

Shlomi Fish — 2007-07-01T12:49:11

That's right. Well, the thing is that it is very unlikely, I will create a different glob with the name "$mn", which will be different than a subroutine. But point taken. If it returns anything except an array ref, then I'd like to know about it. So I can assume that the contract of the function will be that, and that the functions of those names will be dedicated for them. As for the origin: this code is originally based on a concept that Damian Conway introduced in Class::Std ( http://search.cpan.org/dist/Class-Std/ ) - the "CUMULATIVE" methods. I believe I read about it in his Perl Best Practices book. I later implemented this feature in a somewhat different way in Test::Run (without making use of any of Damian's original Class::Std code), and this code here is based on the Test::Run code. Regards, Shlomi Fish --------------------------------------------------------------------- Shlomi Fish shlomif-ik1l9ssToec+JF/nGntIXQ< at >public.gmane.org Homepage: http://www.shlomifish.org/

Re: [QUIZ] Perl 'What does this code do?' Quiz

Shlomi Fish — 2007-07-01T12:37:09

What is XBMLNFUI? I don't get it. Regards, Shlomi Fish --------------------------------------------------------------------- Shlomi Fish shlomif-ik1l9ssToec+JF/nGntIXQ< at >public.gmane.org Homepage: http://www.shlomifish.org/ If it's not in my E-mail it doesn't happen. And if my E-mail is saying one thing, and everything else says something else - E-mail will conquer. -- An Israeli Linuxer

Re: SPOILER: 'What does this code do?' Quiz

Peter Scott — 2007-06-27T21:29:26

Yeah, yeah, yeah, exercise for the reader, etc, etc :-) See, the answer was within you all the time ;-)

Re: SPOILER: 'What does this code do?' Quiz

Ron Isaacson — 2007-06-27T20:42:59

Good catch, but of course you wouldn't want to actually do that... what if $m->($self) is very expensive, or has side effects? There's also a race condition: how can you be sure that an arrayref return from the first invocation of $m->($self) guarantees an arrayref return (whether or not the same data) from the second invocation? my $result = $m->($self); push < at >r, < at >$result if (ref $result eq 'ARRAY'); -- Ron Isaacson Morgan Stanley ron.isaacson-/PgpppG8B+R7qynMiXIxWgC/G2K4zDHf< at >public.gmane.org / (212) 762-1950

Re: [QUIZ] Perl 'What does this code do?' Quiz

Rob Kinyon — 2007-06-27T20:22:14

Nice. An mostly complete implementation of XBMLNFUI* in P5. Rob * 13x simpler than rot13 ...

SPOILER: 'What does this code do?' Quiz

Peter Scott — 2007-06-27T20:14:06

$object_or_class->z( { mn => 'funcname' } ) will return a reference to an array of all the list-context results of calling the 'funcname' method in the class of $object_or_class and its ancestors in parental order, assuming that each such method returns an arrayref, and that the above code is present in or inherited by the class of $object_or_class. However, it checks to see only if the glob 'funcname' is defined, not whether there is a subroutine of that name. It will generate a warning if another slot in the glob is used instead. I would rewrite the **** line above as my $m = *{$i . "::$mn"}{CODE}; and to be on the safe side, rewrite the %%%% line as push < at >r, < at >{ ref $m->($self) eq 'ARRAY' ? $m->($self) : [] };

[QUIZ] Perl 'What does this code do?' Quiz

Shlomi Fish — 2007-06-27T19:05:53

Hi all! Here's another "What does this code do?" Quiz. I obfuscated the names of the variable names to provide hinting on their purpose, but the code itself is not obfuscated. You have to guess what the "z()" function does. Good luck! Please post spoilers as response to this post with "SPOILER". Regards, Shlomi Fish <<<<<<<<<<<<<<<<<<<<< use strict; use warnings; use List::MoreUtils (qw(uniq)); our %_t = (); sub t { my $c = shift; if (exists($_t{$c})) { return $_t{$c}; } no strict 'refs'; my < at >h = $c; my < at >d = < at >{$c. '::ISA'}; while (my $p = shift(< at >d)) { push < at >h, $p; push < at >d, < at >{$p. '::ISA'}; } my < at >u = uniq(< at >h); return $_t{$c} = [ sort { $a->isa($b) ? -1 : $b->isa($a) ? +1 : 0 } < at >u ]; } sub z { my ($self, $args) = < at >_; my $mn = $args->{mn}; my $c = ((ref($self) eq "") ? $self : ref($