From b45bef51016c22ea8531ef99e10efc20cdc8f88e Mon Sep 17 00:00:00 2001 From: James Smith Date: Wed, 23 Jun 2021 20:49:25 +0100 Subject: Update README.md --- challenge-118/james-smith/README.md | 53 ++++++++++++++++++++++++++++++++++++- 1 file changed, 52 insertions(+), 1 deletion(-) diff --git a/challenge-118/james-smith/README.md b/challenge-118/james-smith/README.md index a4727b0222..4f73c4cb1a 100644 --- a/challenge-118/james-smith/README.md +++ b/challenge-118/james-smith/README.md @@ -225,7 +225,7 @@ sub show_rt { } ``` -## Aside - let's eek out the speed. +## Improvement 1 - reduce function calls There is one place where the code could gain a bit of speed. The range checks are performed AFTER the function call not before. We @@ -261,3 +261,54 @@ sub walk_opt { walk_opt( $x+1, $y-2, $seen, $rt ) if $x<7 && $y>1; } ``` + +## Improvement 2 - remove some `if`s + +So we've remove unecessary loops in our first attempt, in our second we have reduced the number of function calls. So we need to see where we can gain more time... + +The only thing left is to reduce the `if` statements in the "heart" of the loop. + +Rather than checking to see if a move from one square in a given direction ("transition") is valid each time - we pre-compute the list of moves, and store it in a "transition" matrix. This reduces overall execution time. + +So we use the logic above to generate an array where the "key" is the square number and the "value" is an array of square numbers that you can reach. + +This gives us the following code: +```perl +sub get_trans { + my $q=[]; + foreach my $y (0..7) { + foreach my $x (0..7) { + my $l = $x + $y * 8; + push @{ $q->[$l] }, $l + 6 if $y<7 && $x > 1; + push @{ $q->[$l] }, $l + 10 if $y<7 && $x < 6; + push @{ $q->[$l] }, $l - 6 if $y>0 && $x < 6; + push @{ $q->[$l] }, $l - 10 if $y>0 && $x > 1; + push @{ $q->[$l] }, $l + 15 if $y<6 && $x > 0; + push @{ $q->[$l] }, $l + 17 if $y<6 && $x < 7; + push @{ $q->[$l] }, $l - 15 if $y>1 && $x < 7; + push @{ $q->[$l] }, $l - 17 if $y>1 && $x > 0; + } + } + return $q; +} +``` + +We then have an optimized version of the walk code: + +```perl +sub walk_trans { + my( $t, $seen, $rt ) = @_; + return if $seen & ( my $v = 1 << $t ); + $seen |= $v; + $rt .= chr $t; + return ($best_rt,$best_len) = ($rt,-1+length $rt) if ($seen & $sol) == $sol; + return if $best_len <= length $rt; + walk_trans( $_, $seen, $rt ) foreach @{$trans->[$t]}; +} +``` + +The eight lines of `if`s go back to a single foreach loop. + +As well as removing the ifs we have a "side-effect" where we no longer need to label squares by their x&y co-ordinates but just by their index 0..63 which also gains us a little speed. + +The time is now down to approximately 10 seconds. -- cgit From 2d43a51169fc3990ae20925bfee344d032d83fba Mon Sep 17 00:00:00 2001 From: drbaggy Date: Wed, 23 Jun 2021 20:50:53 +0100 Subject: added transition matrix version --- challenge-118/james-smith/perl/ch-2.pl | 58 ++++++++++++++++++++++++++-------- 1 file changed, 45 insertions(+), 13 deletions(-) diff --git a/challenge-118/james-smith/perl/ch-2.pl b/challenge-118/james-smith/perl/ch-2.pl index 358b7a1f64..8c7c1a0163 100644 --- a/challenge-118/james-smith/perl/ch-2.pl +++ b/challenge-118/james-smith/perl/ch-2.pl @@ -9,6 +9,7 @@ use Benchmark qw(cmpthese timethis); use Data::Dumper qw(Dumper); my @dir = ([-2,1],[2,1],[-2,-1],[2,-1],[-1,2],[1,2],[-1,-2],[1,-2]); +my $trans = get_trans(); my @treasures = qw(a2 b1 b2 b3 c4 e6); my( $sol, $best_len, $best_rt ) = ( 0, 65 ); @@ -31,7 +32,7 @@ $sol |= 1 << 8 * (substr $_,1) - 105 + ord $_ foreach @treasures; ## to bytes using chr/ord. -walk( 0, 7, 0, q() ); ## Walk the tree starting from top-left +walk_trans( 56, 0, q() ); ## Walk the tree starting from top-left say ''; say "Treasures: @treasures"; @@ -40,8 +41,9 @@ say 'Route: ',show_rt( $best_rt ); ## Show best route say ''; cmpthese( 20, { - 'walk' => sub { $best_len=65; walk( 0, 7, 0, q() ); show_rt($best_rt); }, - 'walk_opt' => sub { $best_len=65; walk_opt( 0, 7, 0, q() ); show_rt($best_rt); }, + 'walk' => sub { $best_len=65; walk( 0, 7, 0, q() ); show_rt($best_rt); }, + 'walk_opt' => sub { $best_len=65; walk_opt( 0, 7, 0, q() ); show_rt($best_rt); }, + 'walk_trans' => sub { $best_len=65; walk_trans( 56, 0, q() ); show_rt($best_rt); }, } ); sub walk { @@ -58,15 +60,6 @@ sub walk { walk( $x + $_->[0], $y + $_->[1], $seen, $rt ) foreach @dir; } -sub show_rt { - my %t = map { $_ => 1 } @treasures; - return join q( ), - map { $_.( exists $t{$_} ? q(*) : q( ) ) } - map { chr( 97 + ($_&7) ).( 1 + ($_>>3) ) } - map { ord $_ } - split m{}, shift; -} - sub walk_opt { my( $x, $y, $seen, $rt ) = @_; ## Skip if the new "chain" will be bigger than the best chain so far @@ -75,7 +68,7 @@ sub walk_opt { return if $seen & ( my $v = 1 << (my$t=$x+$y*8) ); $seen |= $v; $rt .= chr $t; - return ($best_rt,$best_len) = ($rt,-1+length $rt) if ($seen & $sol) == $sol; + return (($best_rt,$best_len) = ($rt,-1+length $rt)) if ($seen & $sol) == $sol; return if $best_len <= length $rt; walk_opt( $x-2, $y+1, $seen, $rt ) if $x>1 && $y<7; walk_opt( $x+2, $y+1, $seen, $rt ) if $x<6 && $y<7; @@ -87,3 +80,42 @@ sub walk_opt { walk_opt( $x+1, $y-2, $seen, $rt ) if $x<7 && $y>1; } +sub show_rt { + my %t = map { $_ => 1 } @treasures; + return join q( ), + map { $_.( exists $t{$_} ? q(*) : q( ) ) } + map { chr( 97 + ($_&7) ).( 1 + ($_>>3) ) } + map { ord $_ } + split m{}, shift; +} + +sub walk_trans { + my( $t, $seen, $rt ) = @_; + ## Skip if the new "chain" will be bigger than the best chain so far + ## If we have fallen off the sides of the board + ## Or if we have already visited the square. + return if $seen & ( my $v = 1 << $t ); + $seen |= $v; + $rt .= chr $t; + return ($best_rt,$best_len) = ($rt,-1+length $rt) if ($seen & $sol) == $sol; + return if $best_len <= length $rt; + walk_trans( $_, $seen, $rt ) foreach @{$trans->[$t]}; +} + +sub get_trans { + my $q=[]; + foreach my $y (0..7) { + foreach my $x (0..7) { + my $l = $x + $y * 8; + push @{ $q->[$l] }, $l + 6 if $y<7 && $x > 1; + push @{ $q->[$l] }, $l + 10 if $y<7 && $x < 6; + push @{ $q->[$l] }, $l - 6 if $y>0 && $x < 6; + push @{ $q->[$l] }, $l - 10 if $y>0 && $x > 1; + push @{ $q->[$l] }, $l + 15 if $y<6 && $x > 0; + push @{ $q->[$l] }, $l + 17 if $y<6 && $x < 7; + push @{ $q->[$l] }, $l - 15 if $y>1 && $x < 7; + push @{ $q->[$l] }, $l - 17 if $y>1 && $x > 0; + } + } + return $q; +} -- cgit From 60aad7093a0078d852ebbd0e4ec7544d733f9d04 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Wed, 23 Jun 2021 21:49:25 +0100 Subject: added minor optimization to trans --- challenge-118/james-smith/perl/ch-2.pl | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/challenge-118/james-smith/perl/ch-2.pl b/challenge-118/james-smith/perl/ch-2.pl index 8c7c1a0163..fb4985349f 100644 --- a/challenge-118/james-smith/perl/ch-2.pl +++ b/challenge-118/james-smith/perl/ch-2.pl @@ -90,18 +90,21 @@ sub show_rt { } sub walk_trans { - my( $t, $seen, $rt ) = @_; - ## Skip if the new "chain" will be bigger than the best chain so far - ## If we have fallen off the sides of the board - ## Or if we have already visited the square. - return if $seen & ( my $v = 1 << $t ); - $seen |= $v; - $rt .= chr $t; + my( $t, $seen, $rt ) = @_; ## Current square, visited squares, current route + return if $seen & 1 << $t; ## Return if we've already been to this square. + $seen |= 1 << $t; ## Mark that we have been in this square. + $rt .= chr $t; ## Add this square to our route. return ($best_rt,$best_len) = ($rt,-1+length $rt) if ($seen & $sol) == $sol; + ## If we've found all the treasure + ## Update the best route (and it's length) + ## and return; return if $best_len <= length $rt; + ## If our route is longer than the best route + ## return; walk_trans( $_, $seen, $rt ) foreach @{$trans->[$t]}; + ## Try all knight move squares from the current + ## square. } - sub get_trans { my $q=[]; foreach my $y (0..7) { -- cgit From bc0ce07f1170260f1bcaf9032cb3e5d699857458 Mon Sep 17 00:00:00 2001 From: James Smith Date: Wed, 23 Jun 2021 21:49:37 +0100 Subject: Update README.md --- challenge-118/james-smith/README.md | 38 +++++++++++++++++++++++++++++++++---- 1 file changed, 34 insertions(+), 4 deletions(-) diff --git a/challenge-118/james-smith/README.md b/challenge-118/james-smith/README.md index 4f73c4cb1a..01fbce897c 100644 --- a/challenge-118/james-smith/README.md +++ b/challenge-118/james-smith/README.md @@ -293,17 +293,47 @@ sub get_trans { } ``` +The numbers 6, 10, 15 and 17 come from looking at the grid above.... + +``` + ... +15 ... +17 ... + +6 ... ... ... +10 + ... ... *** ... ... + -10 ... ... ... -6 + ... -17 ... -15 ... +``` We then have an optimized version of the walk code: +The array looks something like: +``` +[ + [10,17] + [11,16,18] + [8,12,17,19] + [9,13,18,20] + [10,14,19,21] + [11,15,20,22] + [12,21,23] + [13,22] + .... +] + ```perl sub walk_trans { - my( $t, $seen, $rt ) = @_; - return if $seen & ( my $v = 1 << $t ); - $seen |= $v; - $rt .= chr $t; + my( $t, $seen, $rt ) = @_; ## Current square, visited squares, current route + return if $seen & 1 << $t; ## Return if we've already been to this square. + $seen |= 1 << $t; ## Mark that we have been in this square. + $rt .= chr $t; ## Add this square to our route. return ($best_rt,$best_len) = ($rt,-1+length $rt) if ($seen & $sol) == $sol; + ## If we've found all the treasure + ## Update the best route (and it's length) + ## and return; return if $best_len <= length $rt; + ## If our route is longer than the best route + ## return; walk_trans( $_, $seen, $rt ) foreach @{$trans->[$t]}; + ## Try all knight move squares from the current + ## square. } ``` -- cgit From 516d403dfb48af20039960271bd639fa50f0a340 Mon Sep 17 00:00:00 2001 From: James Smith Date: Wed, 23 Jun 2021 22:09:26 +0100 Subject: Update README.md --- challenge-118/james-smith/README.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/challenge-118/james-smith/README.md b/challenge-118/james-smith/README.md index 01fbce897c..f3a6bdf930 100644 --- a/challenge-118/james-smith/README.md +++ b/challenge-118/james-smith/README.md @@ -273,6 +273,7 @@ Rather than checking to see if a move from one square in a given direction ("tra So we use the logic above to generate an array where the "key" is the square number and the "value" is an array of square numbers that you can reach. This gives us the following code: + ```perl sub get_trans { my $q=[]; @@ -317,6 +318,9 @@ The array looks something like: [13,22] .... ] +``` + +The walk sub then becomes the simpler: ```perl sub walk_trans { -- cgit From 7a18183caea916deab974cf6b64cc62465af4ccf Mon Sep 17 00:00:00 2001 From: drbaggy Date: Wed, 23 Jun 2021 23:34:55 +0100 Subject: whitespace --- challenge-118/james-smith/perl/ch-2.pl | 1 + 1 file changed, 1 insertion(+) diff --git a/challenge-118/james-smith/perl/ch-2.pl b/challenge-118/james-smith/perl/ch-2.pl index fb4985349f..5e1d821aae 100644 --- a/challenge-118/james-smith/perl/ch-2.pl +++ b/challenge-118/james-smith/perl/ch-2.pl @@ -105,6 +105,7 @@ sub walk_trans { ## Try all knight move squares from the current ## square. } + sub get_trans { my $q=[]; foreach my $y (0..7) { -- cgit From 30d9e7f8c3b11def2ed2001593cb6f7ec39b8964 Mon Sep 17 00:00:00 2001 From: James Smith Date: Thu, 24 Jun 2021 00:01:26 +0100 Subject: Update README.md --- challenge-118/james-smith/README.md | 99 +++++++++++++++++++++++++++++++++++-- 1 file changed, 95 insertions(+), 4 deletions(-) diff --git a/challenge-118/james-smith/README.md b/challenge-118/james-smith/README.md index f3a6bdf930..112ab8cc06 100644 --- a/challenge-118/james-smith/README.md +++ b/challenge-118/james-smith/README.md @@ -41,13 +41,32 @@ start from the top-left square.*** ## The technique +*To start with I didn't want to look up any "ideal" solution for this +problem - but start from first principles and see if we can get +a "brute force" solution to come back in a reasonable time!* + This week unfortunately we are not going to avoid a recursive solution. The problem leads us in this direction, as at each step we have to test up to 8 "next steps" - the directions of the knight moves. -BUT - to simplify our code solution - we want to avoid a solution which -requires loops within our recursive function - other than the one which -looks at the "next" step. +The brute force algorithm is: + + * check to see if we've visited the square before; stop + * update route; + * check to see if we've found the solution; + * try all moves from the current location; + +If we are looking for the shortest route - we can also add a clause which +says stop if the route we've got is equal to or longer in length than the +current best route. + +### Avoiding loops +To simplify our code solution, and increase performance we want to +remove the need for any extraneous loops, and also the use of arrays +as there are many overheads to using arrays. + +We want to avoid a solution which requires loops within our recursive +function - other than the one which looks at the "next" step. We note that the chessboard has 64 squares and that Perl has 64-bit integers. We note therefore that we can represent the location of an @@ -116,7 +135,7 @@ square we are in (0..63). We can just store this in an array. But to avoid the array overhead instead we can just store it in a byte string, using `chr $loc`. -## The solution +## Our first solution ### The "main code" @@ -346,3 +365,75 @@ The eight lines of `if`s go back to a single foreach loop. As well as removing the ifs we have a "side-effect" where we no longer need to label squares by their x&y co-ordinates but just by their index 0..63 which also gains us a little speed. The time is now down to approximately 10 seconds. + +## Notes + +### Transition matrix +```perl +[ + [10, 17], + [11, 16, 18], + [8, 12, 17, 19], + [9, 13, 18, 20], + [10, 14, 19, 21], + [11, 15, 20, 22], + [12, 21, 23], + [13, 22], + [2, 18, 25], + [3, 19, 24, 26], + [0, 4, 16, 20, 25, 27], + [1, 5, 17, 21, 26, 28], + [2, 6, 18, 22, 27, 29], + [3, 7, 19, 23, 28, 30], + [4, 20, 29, 31], + [5, 21, 30], + [1, 10, 26, 33], + [0, 2, 11, 27, 32, 34], + [1, 3, 8, 12, 24, 28, 33, 35], + [2, 4, 9, 13, 25, 29, 34, 36], + [3, 5, 10, 14, 26, 30, 35, 37], + [4, 6, 11, 15, 27, 31, 36, 38], + [5, 7, 12, 28, 37, 39], + [6, 13, 29, 38], + [9, 18, 34, 41], + [8, 10, 19, 35, 40, 42], + [9, 11, 16, 20, 32, 36, 41, 43], + [10, 12, 17, 21, 33, 37, 42, 44], + [11, 13, 18, 22, 34, 38, 43, 45], + [12, 14, 19, 23, 35, 39, 44, 46], + [13, 15, 20, 36, 45, 47], + [14, 21, 37, 46], + [17, 26, 42, 49], + [16, 18, 27, 43, 48, 50], + [17, 19, 24, 28, 40, 44, 49, 51], + [18, 20, 25, 29, 41, 45, 50, 52], + [19, 21, 26, 30, 42, 46, 51, 53], + [20, 22, 27, 31, 43, 47, 52, 54], + [21, 23, 28, 44, 53, 55], + [22, 29, 45, 54], + [25, 34, 50, 57], + [24, 26, 35, 51, 56, 58], + [25, 27, 32, 36, 48, 52, 57, 59], + [26, 28, 33, 37, 49, 53, 58, 60], + [27, 29, 34, 38, 50, 54, 59, 61], + [28, 30, 35, 39, 51, 55, 60, 62], + [29, 31, 36, 52, 61, 63], + [30, 37, 53, 62], + [33, 42, 58], + [32, 34, 43, 59], + [33, 35, 40, 44, 56, 60], + [34, 36, 41, 45, 57, 61], + [35, 37, 42, 46, 58, 62], + [36, 38, 43, 47, 59, 63], + [37, 39, 44, 60], + [38, 45, 61], + [41, 50], + [40, 42, 51], + [41, 43, 48, 52], + [42, 44, 49, 53], + [43, 45, 50, 54], + [44, 46, 51, 55], + [45, 47, 52], + [46, 53], +] +``` -- cgit