Merge pull request #10586 from atschneid/master

ATSchneid PWC 281 

8 files changed, 348 insertions, 6 deletions

diff --git a/challenge-281/atschneid/README.md b/challenge-281/atschneid/README.md
index 2ca96b7298..88ea651719 100644
--- a/challenge-281/atschneid/README.md
+++ b/challenge-281/atschneid/README.md
@@ -1,11 +1,137 @@
-# Perl Weekly Challenge 280
+# Chess Moves
 
-**Challenge 280 solutions by Andrew Schneider**
+**Challenge 281 solutions by Andrew Schneider**
 
-[PWC 280](https://theweeklychallenge.org/blog/perl-weekly-challenge-280/)
+[PWC 281](https://theweeklychallenge.org/blog/perl-weekly-challenge-281/)
 
-Unlike past weeks I only used Perl for this Perl Weekly Challenge. How novel! I don't feel like I have enough to say about this challenge to make a pseudo-readme-blog post about it. Sorry fans.
+Two related challenges this week, both involving the chess board. The first one has a trick regarding odds and evens. The second one I solve via Breadth First Search
 
-The solutions in Perl came pretty easily, they played to Perl's strengths for sure. I would have struggled a bit more solving these in my usual menagerie of programming languages.
+## TASK 1: Check Color
 
-Thanks for the challenges! See you next week.
+> Task 1: Check Color</br>
+> Submitted by: Mohammad Sajid Anwar</br>
+> You are given coordinates, a string that represents the coordinates of a square of the chessboard as shown below:</br>
+> </br>
+> Write a script to return true if the square is light, and false if the square is dark.</br>
+> </br>
+> Example 1</br>
+> Input: $coordinates = "d3"</br>
+> Output: true</br>
+> </br>
+> Example 2</br>
+> Input: $coordinates = "g5"</br>
+> Output: false</br>
+> </br>
+> Example 3</br>
+> Input: $coordinates = "e6"</br>
+> Output: true
+
+The trick to this one is to realize that if you convert the letters to numbers, in a sensible way such as 'a' -> 1, 'b' -> 2, etc., you can figure out the color of the space by summing the index, and checking if it is odd or even. Which one you want for the black or white square depends on your conversion.
+
+```perl
+sub check_square( $key ) {
+    return sum( map { ord($_) } split '', $key ) % 2;
+}
+```
+
+Conveniently the character '1' and the character 'a' both are represented by an odd number, so we don't need to do any conversion besides converting the characters into their ascii using `ord`.
+
+We pass this function a space index, like 'a1', as a string. We split the string into its characters, convert each to its ascii, sum up the values, and modulo it by 2. 
+
+This function works on the example input. It would also output a value for any two character string, or any string at all for that matter! Is this a feature or a bug? Not sure! but we could always add in some length and value checks to error on bad input.
+
+## Task 2: Knight's Move
+
+> Task 2: Knight’s Move</br>
+> Submitted by: Peter Campbell Smith</br>
+> A Knight in chess can move from its current position to any square two rows or columns plus one column or row away. So in the diagram below, if it starts a S, it can move to any of the squares marked E.</br>
+> </br>
+> Write a script which takes a starting position and an ending position and calculates the least number of moves required.</br>
+> </br>
+> Example 1</br>
+> Input: $start = 'g2', $end = 'a8'</br>
+> Ouput: 4</br>
+> </br>
+> g2 -> e3 -> d5 -> c7 -> a8</br>
+> </br>
+> Example 2</br>
+> Input: $start = 'g2', $end = 'h2'</br>
+> Ouput: 3</br>
+> </br>
+> g2 -> e3 -> f1 -> h2
+
+The high level idea here is: to get to the start space takes zero moves. To get to any space takes 1 additional move, and any space from there is 1+1 moves, and so on.
+
+So we mark the start space with value 0, then find all spaces we can reach from this one, mark them with value 1, then repeat the same for each space, and repeat, and repeat. If the space has been visited already, we skip it, since we have already found the shortest number of moves to get there. And if we land on the end space we return its value.
+
+To store the list of spaces to inspect I use a FIFO queue to ensure the search is breadth-first, which makes the algorithm more efficient -- we don't have to check if the value is the minimum and we can reliably inspect each space only once. The BFS solution for this problem is $\mathcal O (8 \times 8)$, that is, it's linear in the board size.
+
+```perl
+sub knight_path( $start_key, $end_key ){
+    my @queue = ($start_key);
+    my %board;
+    $board{ $start_key } = 0;
+
+    while ( $#queue >= 0 ) {
+	my $current = shift @queue;
+	if ($current eq $end_key) {
+	    return $board{ $current };
+	}
+	for ( get_moves( $current ) ) {
+	    if ( !exists $board{ $_ } ) {
+		push @queue, $_;
+		$board{ $_ } = $board{ $current } + 1;
+	    }
+	}
+    }
+}
+```
+
+For the queue I use a normal list and access elements using `shift` and add elements using `push`. For the board I use a hashmap with the string index key as the key, if the key is in the map then we know we have inspected the space already.
+
+The trickiest part here was generating the list of possible next moves from each space
+
+```perl
+sub get_moves( $key ) {
+    my @moves = (
+	[2, 1], [1, 2], [-2, 1], [1, -2],
+	[2, -1], [-1, 2], [-2, -1], [-1, -2]
+	);
+
+    my @idx = split '', $key;
+    my @next_moves = ();
+    for (@moves) {
+	my @candidate = (
+	    ord($idx[0]) + $_->[0],
+	    ord($idx[1]) + $_->[1]
+	    );
+	if (
+	    $candidate[0] >= ord('a') and
+	    $candidate[0] <= ord('h') and
+	    $candidate[1] >= ord('1') and
+	    $candidate[1] <= ord('8')
+	    ) {
+	    push @next_moves, join '', map { chr( $_ ) } @candidate;
+	}
+    }
+    return @next_moves;
+}
+```
+
+The knight can move in a 1,2 L shape from its current location. For each of the 8 possibilities, we return a list of only the legal moves that land within the board dimensions.
+
+That's about that. The Perl solution is pretty speedy.
+
+## Others
+
+I also wrote solutions in Julia and Racket this week. Task 1 was easy in each. For task 2, in Julia I used a 8 by 8 matrix for the board, becuaes it felt intuitive, but addressing each square seemed more complicated than it should have been. In Julia you can do something like `*(1, 2)` to return the values `1` and `2`, but you can't seem to do this with a variable. Like `v = (1, 2); *v` throws an error. Also the Julia version takes longer (anecdotally) to run than the Perl version. I'm sure there are some easy changes that would speed things up.
+
+As for Racket, well, ... it's done and it gives the correct answer. I used a library to get a queue data structure. For stacks, oh you want stacks? Racket can do stacks! But queues are a problem. I probably should have implemented my own using structs. Or, as i did in Julia, just use an array with a start index to simulate a queue. 
+
+## Conclusion
+
+That's it for this week. I did these challenges while on vacation. They helped to keep my brain from otherwise atrophying.
+
+Oh, also, thanks to Mohammad and the Perl Weekly Challenge committee for acknowledging me! Why do I do this? Surely not for the fame and notoriety, but those things help! Ha!
+
+See you next week!
diff --git a/challenge-281/atschneid/blog.txt b/challenge-281/atschneid/blog.txt
new file mode 100644
index 0000000000..5c09198c3f
--- /dev/null
+++ b/challenge-281/atschneid/blog.txt
@@ -0,0 +1 @@
+https://github.com/atschneid/perlweeklychallenge-club/blob/master/challenge-281/atschneid/README.md
diff --git a/challenge-281/atschneid/julia/ch-1.jl b/challenge-281/atschneid/julia/ch-1.jl
new file mode 100644
index 0000000000..407ff22466
--- /dev/null
+++ b/challenge-281/atschneid/julia/ch-1.jl
@@ -0,0 +1,9 @@
+
+function check_square( key )
+    column, row = collect( key )
+    (Int(column) + Int(row)) % 2 == 1
+end
+
+for input = ["a1", "f1", "d8"]
+    println( input, " => ", check_square(input) )
+end
diff --git a/challenge-281/atschneid/julia/ch-2.jl b/challenge-281/atschneid/julia/ch-2.jl
new file mode 100644
index 0000000000..eca30455e4
--- /dev/null
+++ b/challenge-281/atschneid/julia/ch-2.jl
@@ -0,0 +1,54 @@
+
+function convert_key_to_idxs( key )
+    column, row = collect( key )
+    idx_c = Int(column) - 96
+    idx_r = Int(row) - 48
+    
+    idx_c > 0 && idx_c <= 8 &&
+        idx_r > 0 && idx_r <= 8 ||
+        error("bad range for key " * key)
+    
+    [idx_c, idx_r]
+end
+
+function get_moves( idx )
+    moves = []
+    to_check = [[2, 1], [1, 2], [-2, 1], [1, -2],
+                [2, -1], [-1, 2], [-2, -1], [-1, -2]]
+    for check in to_check
+        next = idx + check
+        if next[1] > 0 && next[1] <= 8 && next[2] > 0 && next[2] <= 8
+            push!( moves, next )
+        end
+    end
+    moves
+end
+
+function knight_path( start_key, end_key )
+    start_idx = convert_key_to_idxs( start_key )
+    end_idx = convert_key_to_idxs( end_key )
+
+    board = -1 * ones( 8, 8 )
+
+    queue = [start_idx]
+    board[start_idx[1], start_idx[2]] = 0
+    q_idx = 1
+    while q_idx <= size( queue, 1)
+        current = queue[q_idx]
+        if current == end_idx
+            return board[current[1], current[2]]
+        end
+        for next_pos in get_moves(queue[q_idx])
+            if board[next_pos[1], next_pos[2]] == -1
+                push!( queue, next_pos )
+                board[next_pos[1], next_pos[2]] = board[current[1], current[2]] + 1
+            end
+        end
+        q_idx += 1
+    end
+    return -1
+end
+
+for input = [("a1", "f1"), ("g2", "a8"), ("g2", "h2"), ("a1", "h8")]
+    println( input, " => ", knight_path(input[1], input[2]) )
+end
diff --git a/challenge-281/atschneid/perl/ch-1.pl b/challenge-281/atschneid/perl/ch-1.pl
new file mode 100644
index 0000000000..0c579379cc
--- /dev/null
+++ b/challenge-281/atschneid/perl/ch-1.pl
@@ -0,0 +1,15 @@
+use warnings;
+use strict;
+
+use List::Util qw(sum);
+
+use v5.38;
+
+my @inputs = ("a1", "f1", "d8");
+for (@inputs) {
+    say $_ . ' => ' . ( check_square($_) ? 'true' : 'false' );
+}
+
+sub check_square( $key ) {
+    return sum( map { ord($_) } split '', $key ) % 2;
+}
diff --git a/challenge-281/atschneid/perl/ch-2.pl b/challenge-281/atschneid/perl/ch-2.pl
new file mode 100644
index 0000000000..bec32fc309
--- /dev/null
+++ b/challenge-281/atschneid/perl/ch-2.pl
@@ -0,0 +1,59 @@
+use warnings;
+use strict;
+
+use v5.38;
+
+my @inputs = (
+    ["a1", "f1"],
+    ["g2", "a8"],
+    ["g2", "h2"],
+    ["a1", "h8"]
+    );
+for (@inputs) {
+    my @keys = @$_;
+    say "($keys[0], $keys[1])  => " . knight_path($keys[0], $keys[1]);
+}
+
+sub get_moves( $key ) {
+    my @moves = (
+	[2, 1], [1, 2], [-2, 1], [1, -2],
+	[2, -1], [-1, 2], [-2, -1], [-1, -2]
+	);
+
+    my @idx = split '', $key;
+    my @next_moves = ();
+    for (@moves) {
+	my @candidate = (
+	    ord($idx[0]) + $_->[0],
+	    ord($idx[1]) + $_->[1]
+	    );
+	if (
+	    $candidate[0] >= ord('a') and
+	    $candidate[0] <= ord('h') and
+	    $candidate[1] >= ord('1') and
+	    $candidate[1] <= ord('8')
+	    ) {
+	    push @next_moves, join '', map { chr( $_ ) } @candidate;
+	}
+    }
+    return @next_moves;
+}
+
+sub knight_path( $start_key, $end_key ){
+    my @queue = ($start_key);
+    my %board;
+    $board{ $start_key } = 0;
+
+    while ( $#queue >= 0 ) {
+	my $current = shift @queue;
+	if ($current eq $end_key) {
+	    return $board{ $current };
+	}
+	for ( get_moves( $current ) ) {
+	    if ( !exists $board{ $_ } ) {
+		push @queue, $_;
+		$board{ $_ } = $board{ $current } + 1;
+	    }
+	}
+    }
+}
diff --git a/challenge-281/atschneid/racket/ch-1.rkt b/challenge-281/atschneid/racket/ch-1.rkt
new file mode 100644
index 0000000000..52ba115570
--- /dev/null
+++ b/challenge-281/atschneid/racket/ch-1.rkt
@@ -0,0 +1,20 @@
+#lang typed/racket
+
+(: key->idx (-> String (Listof Integer)))
+(define (key->idx k)
+  (let* ([cr (string->list k)]
+         [col : Integer (- (char->integer (car cr)) (char->integer #\a))]
+         [row : Integer (- (char->integer (car (cdr cr))) (char->integer #\1))])
+    (list col row)))
+
+(: check-color (-> String Boolean))
+(define (check-color key)
+  (let ([idxs (key->idx key)])
+    (equal? (modulo (apply + idxs) 2) 1)))
+
+(let loop ([inputs '("d3" "g5" "e6")])
+  (if (null? inputs)
+      #t
+      (begin
+        (printf "~a => ~a~n" (car inputs) (check-color (car inputs)))
+        (loop (cdr inputs)))))
\ No newline at end of file
diff --git a/challenge-281/atschneid/racket/ch-2.rkt b/challenge-281/atschneid/racket/ch-2.rkt
new file mode 100644
index 0000000000..0d1138e67d
--- /dev/null
+++ b/challenge-281/atschneid/racket/ch-2.rkt
@@ -0,0 +1,58 @@
+#lang typed/racket
+(require math/array)
+(require pfds/queue/bankers)
+
+(: key->idx (-> String (Vectorof Integer)))
+(define (key->idx k)
+  (let* ([cr (string->list k)]
+         [col : Integer (- (char->integer (car cr)) (char->integer #\a))]
+         [row : Integer (- (char->integer (car (cdr cr))) (char->integer #\1))])
+    (vector col row)))
+
+(define knight-moves '((2  1) (1 2) (-2 1) (1 -2) (2 -1) (-1 2) (-2 -1) (-1 -2)))
+
+(: get-moves (-> (Vectorof Integer) (Listof (Vectorof Integer))))
+(define (get-moves idx)
+  (let loop ([knight-moves : (Listof (Listof Integer)) knight-moves]
+             [next-moves : (Listof (Vectorof Integer)) '()])
+    (if (null? knight-moves)
+        next-moves
+        (let* ([move : (Listof Integer) (car knight-moves)]
+               [k-next (vector (+ (vector-ref idx 0) (car move))
+                               (+ (vector-ref idx 1) (car (cdr move))))])
+          (if (and (>= (vector-ref k-next 0) 0)
+                   (>= (vector-ref k-next 1) 0)
+                   (< (vector-ref k-next 0) 8)
+                   (< (vector-ref k-next 1) 8))
+              (loop (cdr knight-moves) (cons k-next next-moves))
+              (loop (cdr knight-moves) next-moves))))))
+
+(: knight-path (-> String String Integer))
+(define (knight-path start-key end-key)
+  (let ([board (array->mutable-array (make-array #(8 8) -1))]
+        [end-idx (key->idx end-key)])
+    (array-set! board (key->idx start-key) 0)
+    (let loop ([idx-queue (queue (key->idx start-key))])
+      (if (empty? idx-queue) -1
+          (let ([current (head idx-queue)])
+            (if (equal? current end-idx)
+                (array-ref board current)
+                (let move-loop ([moves (get-moves current)]
+                                [idx-queue idx-queue])
+                  (if (null? moves)
+                      (loop (tail idx-queue))
+                      (let ([next-move (car moves)])
+                        (if (eq? (array-ref board next-move) -1)
+                            (begin
+                              (array-set! board next-move (add1 (array-ref board current)))
+                              (move-loop (cdr moves) (enqueue next-move idx-queue)))
+                            (move-loop (cdr moves) idx-queue)))))))))))
+
+(let loop ([inputs '(("a1" "f1") ("g2" "a8") ("g2" "h2") ("a1" "h8"))])
+  (if (null? inputs)
+      #t
+      (begin
+        (printf "~a => ~a~n" (car inputs) (apply knight-path (car inputs)))
+        (loop (cdr inputs)))))
+  
+  
\ No newline at end of file