RogerBW's Blog

Perl Weekly Challenge 118: Binary Knight 23 June 2021

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.

See also:
Perl Weekly Challenge 38: date parsing and word games


  1. Posted by RogerBW at 03:50pm on 28 June 2021

    Part 1: this didn't offer much scope for weird solutions, though there's a neat trick with a recursive regexp (which I would never use in production code, but that's me). A slight optimisation is to return false if the input is even.

    I should also mention the obligatory OEIS entry, the sequence of numbers for which this condition is true. This confirms that there isn't a standard generator function.

    Part 2: another approach was to do a breadth-first search on the entire problem, which I suspect is less efficient than my partitioning approach but I'm not going to go back to try to prove it.

    Part 2's author used an approach involving a precalculated move length table, which seems appropriately cunning.

Comments on this post are now closed. If you have particular grounds for adding a late comment, comment on a more recent post quoting the URL of this one.

Search
Archive
Tags 1920s 1930s 1940s 1950s 1960s 1970s 1980s 1990s 2000s 2010s 3d printing action aeronautics aikakirja anecdote animation anime army astronomy audio audio tech aviation base commerce battletech beer boardgaming book of the week bookmonth chain of command children chris chronicle church of no redeeming virtues cold war comedy computing contemporary cornish smuggler cosmic encounter coup covid-19 cycling dead of winter doctor who documentary drama driving drone ecchi economics espionage essen 2015 essen 2016 essen 2017 essen 2018 essen 2019 existential risk falklands war fandom fanfic fantasy feminism film firefly first world war flash point flight simulation food garmin drive gazebo genesys geocaching geodata gin gkp gurps gurps 101 gus harpoon historical history horror hugo 2014 hugo 2015 hugo 2016 hugo 2017 hugo 2018 hugo 2019 hugo 2020 hugo-nebula reread in brief avoid instrumented life julie enfield kickstarter learn to play leaving earth linux liquor lovecraftiana mecha men with beards museum music mystery naval non-fiction one for the brow opera parody paul temple perl perl weekly challenge photography podcast politics postscript powers prediction privacy project woolsack pyracantha python quantum rail raku ranting raspberry pi reading reading boardgames social real life restaurant reviews romance rpg a day rpgs ruby rust science fiction scythe second world war security shipwreck simutrans smartphone south atlantic war squaddies stationery steampunk stuarts suburbia superheroes suspense television the resistance thirsty meeples thriller tin soldier torg toys trailers travel type 26 type 31 type 45 vietnam war war wargaming weather wives and sweethearts writing about writing x-wing young adult
Special All book reviews, All film reviews
Produced by aikakirja v0.1