RogerBW's Blog

I’ve been doing the Perl Weekly Challenges. The latest involved binary palindromes and a restricted Knight's Tour. (Note that this is open until 27 June 2021.)

TASK #1 › Binary Palindrome

You are given a positive integer $N.

Write a script to find out if the binary representation of the given integer is Palindrome. Print 1 if it is otherwise 0.

Pretty straightforward really. Convert integer to binary representation; check whether that representation is a palindrome.

To make things a little more interesting, rather than just using reverse and equivalents, I wrote a step-by-step comparison which should in principle be faster than reversing the string and testing for equality.

Here's the Python. As in most of these languages, I can get individual substring characters with an index accessor.

def bp(n):

The binary string:

  s="{0:b}".format(n)

Its length, because we'll be using that as an offset.

  l=len(s)-1

The first half of the string:

  for i in range(int(l/2)+1):

Compared with the corresponding character from the second half.

    if s[i] != s[l-i]:
      return 0

If we didn't fail at some point, we succeeded.

  return 1

TASK #2 › Adventure of Knight

A knight is restricted to move on an 8×8 chessboard. The knight is denoted by N and its way of movement is the same as what it is defined in Chess.

There are 6 squares with treasures.

Write a script to find the path such that Knight can capture all treasures. The Knight can start from the top-left square.

BONUS: If you believe that your algorithm can output one of the shortest possible path.

This isn't quite a Knight's Tour (though that would technically be a solution, just not a short one): most obviously, we don't have to visit every square. But more importantly, it's permissible to visit a square more than once – obviously not within a single bound (a sequence of moves from a treasure or starting square to another treasure), because we're looking for shortest routes, but perhaps in two successive bounds.

So I took a hierarchical approach. At the core is findroute, which finds a shortest knight's-move route from point A to point B. That's my standard breadth-first search pattern with a rolling buffer. (l2c is a utility function to convert a chessboard location such as "a8" to a coordinate pair such as [0,7].)

sub findroute {
  my ($a,$b)=@_;
  my $target=l2c($b);
  my $rt;
  my @chain=([l2c($a)]);
 SEARCH:

In each pass, take the first chain entry (which will be shortest or equal shortest of all entries on the chain), and append to it each possible legal move.

  while (my $c=shift @chain) {
    foreach my $offset (
      [-2,-1],
      [-1,-2],
      [-2,1],
      [1,-2],
      [2,-1],
      [-1,2],
      [2,1],
      [1,2],
        ) {
      my $x=$c->[-1][0]+$offset->[0];
      my $y=$c->[-1][1]+$offset->[1];
      if ($x>=0 && $x<=7 && $y>=0 && $y<=7) {

If we land on the target, log that as a shortest-possible-route and break out of the loop. Otherwise, append it to the chain as a new candidate route.

        my $rl=[@{$c},[$x,$y]];
        if ($x==$target->[0] && $y==$target->[1]) {
          $rt=$rl;
          last SEARCH;
        } else {
          push @chain,$rl;
        }
      }
    }
  }
  return $rt;
}

This might go a bit faster if I checked and avoided backtracking, but even without that it runs pretty well.

So that gives me a way of finding a shortest route from point to point. Then it's just a matter of testing each permutation of points for the total route length that that permutation takes, and picking the shortest of those. (I could calculate all the route pairs in advance, but it's just as effective to cache each calculation I do with memoize.) I've written actual permutation code before for these things so now I allow myself the non-core module Algorithm::Permute.

aok('a8',[qw(e6 c4 b3 a2 b2 b1)]);

sub aok {
  my ($start,$t)=@_;
  my @arr=@{$t};
  my $ml;
  my @mu;
  Algorithm::Permute::permute {
    my @r=($start,@arr);
    my $l=0;
    my @m=();
    foreach my $i (0..$#r-1) {
      push @m,findroute($r[$i],$r[$i+1]);
      $l+=scalar @{$m[-1]}-1;
    }
    if (!defined $ml || $l < $ml) {
      $ml=$l;
      @mu=@m;
    }
  } @arr;

(It's not a "real" block attached to the permute method, thus the need to reset @m each time it's declared.)

Then it's just a matter of formatting the contents of @mu for human-readable output. (c2l is the converse of the earlier l2c.)

  print "$start\n";
  foreach my $mv (@mu) {
    my @r;
    foreach my $i (1..$#{$mv}) {
      push @r,c2l($mv->[$i]);
    }
    print join(' ',map {"-> $_"} @r),"\n";
  }
  print "\n$ml moves\n";
}

But having done this – all of which is basically techniques I've used in other PWC answers, and which I knew would have the fiddliness of array copying in other languages – I found in myself a sudden lack of enthusiasm for converting it to other languages, so I didn't.

Full code on github.