Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Knight's Tour Problem in Perl

by ptoulis (Scribe)
on Dec 01, 2008 at 01:44 UTC ( [id://726971]=perlquestion: print w/replies, xml ) Need Help??

ptoulis has asked for the wisdom of the Perl Monks concerning the following question:

There was an article yesterday in Shashdot about writing a Python script that solved the Knight's Tour Problem in 60 lines and less than 1 second for a 100x100 board. PerlMonks have already been encountered with this problem in this node but the question remained unanswered. So, I spent some time and made a Perl script, much shorter (35 lines) and faster (<<1sec) for the same benchmark. If you feel like spending some leisure time over the problem and try to squeeze more the Perl solution, I would be happy to hear some thoughts. Here is my code.
if(@ARGV<4) {print "\nUse: SIZE START_X START_Y [0,1]" and exit;} our ($N,$X0,$Y0,$VERBOSE) = @ARGV ; our ($MOVES,@moves,@board)= (0,([-2,-1], [-1,-2], [-2 ,1],[-1 ,2], [2 +,-1], [1, -2],[2, 1],[1, 2]),()); my $last_move = [$X0,$Y0] and inform_board(); $last_move = inform_board($last_move) while($MOVES< $N*$N); ############### SUBROUTINES ######################## sub init { return ($_[0]>$N/2)? init($N-1-$_[0],$_[1]) : ($_[1]>$N/2? +init($_[0],$N-1-$_[1]):($_[0]>=2 && $_[1]>=2? 8:(($_[0] >=2 && $_[1]= +=1 || $_[1]>=2 && $_[0]==1)?6:($_[0]+$_[1]>1?4:($_[0]+$_[1]==1?3:2))) +) )} sub inRange{ my ($pos, $D) = @_; my ($x,$y) = ($pos->[0]+$D->[0], $pos->[1]+$D->[1]); return ($x>=0 && $x<$N && $y >= 0 && $y<$N && $board[$x][$y]>=0)? + [$x,$y] : 0; } sub inform_board { my ($moved_to) = @_; if($moved_to) { $MOVES++; print "\n$MOVES.",$moved_to->[0],",",$moved_to->[1] if $VERBOSE; my ($MIN,$next_to_move) = (10,[]); foreach(@moves) { if(my $finalPos = inRange($moved_to, $_)) { my $value_ref = \$board[$finalPos->[0]][$finalPos->[1]]; ($MIN,$next_to_move, $board[$moved_to-> [0]][$moved_to->[1]]) = +($$value_ref,$finalPos,0) if(--$$value_ref>=0 && $$value_ref < $MIN); + } } return $next_to_move; } else { push @board, [(0)x $N] for(1..$N); for my $i (0..$N-1) { $board[$i][$_] = init($i,$_) for (0..$N-1);} } }


Some hints: The Warnsdorff's algorithm is used for the solution.
init() initializes the board
inRange() Says is a knight move is inside the board limits
inform_board() Marks the last-visited square of the board and returns the next square to move according to the algorithm

Replies are listed 'Best First'.
Re: Knight's Tour Problem in Perl
by jettero (Monsignor) on Dec 01, 2008 at 02:11 UTC
    Some of your lines are more than one line. The python crowed would likely try to stab your eyes out. At least that's my experience. ... perhaps the only good way to compare program size is by bytes? Also, I'm basically certain that perl golf will not impress python coders. In fact, people like merylin have argued that golf doesn't impress would be perl coders either. ;)

    Still, I value this kind of competition with the python coders. TIMTOWTDI doesn't count there.

    UPDATE: I suppose I wasn't very clear. Many of the one line things in that perl program would most definitely be more than one line in python ... or the python people would get mad and point out that there's only one way to do it. Any way you look at it, perl's meanings can go much farther to the right (if you're in the mood to do so), so a byte count is still better.

    -Paul

      Actually hardly any of the OP's lines were more than one line. However, processing the OP code through Perl tidy and with a little hand tidying (including adding strictures and some blank lines) the code is still only 62 lines long:

      use strict; use warnings; print "\nUse: SIZE START_X START_Y [0,1]" and exit if @ARGV < 4; my ($N, $X0, $Y0, $VERBOSE) = @ARGV; my $MOVES = 0; my @moves = ([-2, -1], [-1, -2], [-2, 1], [-1, 2], [2, -1], [1, -2], [ +2, 1], [1, 2]); my @board; my $last_move = [$X0, $Y0] and inform_board (); $last_move = inform_board ($last_move) while $MOVES < $N * $N; sub init { return ($_[0] > $N / 2) ? init ($N - 1 - $_[0], $_[1]) : ( $_[1] > $N / 2 ? init ($_[0], $N - 1 - $_[1]) : ( $_[0] >= 2 && $_[1] >= 2 ? 8 : ( ($_[0] >= 2 && $_[1] == 1 || $_[1] >= 2 && $_[0] == +1) ? 6 : ($_[0] + $_[1] > 1 ? 4 : ($_[0] + $_[1] == 1 ? 3 : 2 +))) ) ); } sub inRange { my ($pos, $D) = @_; my ($x, $y) = ($pos->[0] + $D->[0], $pos->[1] + $D->[1]); return ($x >= 0 && $x < $N && $y >= 0 && $y < $N && $board[$x][$y] + >= 0) ? [$x, $y] : 0; } sub inform_board { my ($moved_to) = @_; if ($moved_to) { $MOVES++; print "\n$MOVES.$moved_to->[0], $moved_to->[1]" if $VERBOSE; my ($MIN, $next_to_move) = (10, []); foreach (@moves) { if (my $finalPos = inRange ($moved_to, $_)) { my $value_ref = \$board[$finalPos->[0]][$finalPos->[1] +]; ($MIN, $next_to_move, $board[$moved_to->[0]][$moved_to +->[1]]) = ($$value_ref, $finalPos, 0) if (--$$value_ref >= 0 && $$value_ref < $MIN); } } return $next_to_move; } else { push @board, [(0) x $N] for (1 .. $N); for my $i (0 .. $N - 1) { $board[$i][$_] = init ($i, $_) for 0 .. $N - 1; } } }

      Perl's payment curve coincides with its learning curve.
      I can't see which statement should span to more lines. Perhaps the most obscure is the init() function, but this is called once to initialize the board based on hard-wired if-else and so there is no point in making it more 'verbal'. There are also some (a,b,c...)=(func1(), func2 ,func3(),...) statements which I find very handy if done carefully.

      I am not much familiar with Python but I can't see how the equivalent Python code is more readable than this. Even Peter Norvig "former-Lisp-legend", now "Googley-Python-Evangelist", seems to admit there is no real improvement in program readability

      Anyway, I will agree this 'competition' is just for fun (or to keep our teeth sharp!)

        I can't see which statement should span to more lines

        Seeing as you have

        foreach(@moves) { if(my $finalPos = inRange($moved_to, $_))
        and
        for my $i (0..$N-1)  { $board[$i][$_] = init($i,$_) for (0..$N-1);},
        I'd say you do.

        Since all "more lines" statements in Perl are conventions, you could just as well mash all into a one long line and claim yourself the winner. Regardless of anything, counting SLOC in Python have an actual meaning, since the syntax is forcing itself on your style. In Perl, every GNU-style coding is just a K&R away from 30% "improvement".

        "A core tenant of the greater Perl philosophy is to trust that the developer knows enough to solve the problem" - Jay Shirley, A case for Catalyst.

Re: Knight's Tour Problem in Perl
by ggvaidya (Pilgrim) on Dec 01, 2008 at 11:23 UTC

    Put it on CPAN ... then we can go back to the Slashdot article and say it's now a two-liner in Perl:

    cpan -i Puzzle::KnightsTour perl -MPuzzle::KnightsTour -e 'Puzzle::KnightsTour::solve(SIZE, START_ +X, START_Y)'

    (Yes, yes, I know; CPAN is for useful stuff. I'm being silly ... mostly)

Re: Knight's Tour Problem in Perl
by Limbic~Region (Chancellor) on Dec 01, 2008 at 16:34 UTC
    ptoulis,
    Odd. The Wikipedia entry mentions that Warnsdorff's algorithm is a heuristic solution, but doesn't mention under what circumstances it fails. The MathWorld entry for KnightsTour indicates it can fail on boards 76x76. There is a proven linear solution that is far more complicated. It would be nice to implement that solution in perl and then find a case where the Python solution fails - just cause.

    Cheers - L~R

Re: Knight's Tour Problem in Perl
by gone2015 (Deacon) on Dec 01, 2008 at 19:17 UTC

    I don't know what the rules of this game are, but the code below (31 lines) appears to work...

    It ran 100x100, from (0,0) to (97, 92) in 0.33secs on my machine, where the OP code did the same in 0.87. Of course I have cheated and removed all the subroutines and changed the way the edges of the board are detected :-)

    use strict ; use warnings ; use Time::HiRes qw(clock_gettime CLOCK_PROCESS_CPUTIME_ID) ; my $t0 = clock_gettime(CLOCK_PROCESS_CPUTIME_ID) ; my ($N, $x0, $y0, $VERBOSE) = @ARGV ; if ((@ARGV < 4) || ($N < 4) || ($x0 >= $N) || ($y0 >= $N)) { die "Use: SIZE [4..] START_X [0..SIZE-1] START_Y [0..SIZE-1] [0,1]\n +" ; } ; my @moves = ([-2,-1], [-1,-2], [-2 ,1],[-1 ,2], [2 ,-1], [1, -2],[2, 1 +],[1, 2]) ; my @board = ( [(2, 3, (4) x ($N-4), 3, 2, 0, 0)], [(3, 4, (6) x ($N-4) +, 4, 3, 0, 0)], map( { [(4, 6, (8) x ($N-4), 6, 4, 0, 0)] } (1..$N-4) ), [(3, 4, (6) x ($N-4), 4, 3, 0, 0)], [(2, 3, (4) x ($N-4) +, 3, 2, 0, 0)], [(0) x ($N+2)], [(0) x ($N+2)] ) ; for my $move (1..($N * $N) - 1) { my ($MIN, $x, $y) = (10, undef, undef) ; foreach (@moves) { my $vr = \$board[$x0 + $_->[0]][$y0 + $_->[1]] ; next if ($$vr == 0) || (--$$vr >= $MIN) ; ($MIN, $x, $y) = ($$vr, $x0 + $_->[0], $y0 + $_->[1]) ; } ; die "Stuck at ($x0, $y0) at move $move\n" unless defined($x) ; print "$move: ($x0, $y0) -> ($x, $y)\n" if $VERBOSE ; ($board[$x0][$y0], $x0, $y0) = (0, $x, $y) ; } ; print "Ended at ($x0, $y0) in ", clock_gettime(CLOCK_PROCESS_CPUTIME_I +D) - $t0, "\n" ;
      Putting zeroes on the edges plus an OR short-circuit instead of repetitive function calls and BOOM, a huge performance boost. Absolutely brilliant oshalla!
      I wouldn't call anything you did "cheating". The post from the Python programmer was meant to show off his prowess as a programmer and the power of his favorite language. You're just highlighting your prowess as a programmer and the power of Perl. I'd say it's a fair match.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://726971]
Approved by GrandFather
Front-paged by McD
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others surveying the Monastery: (2)
As of 2024-06-13 03:31 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?
    erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.