Merge pull request #10545 from akarelas/pr-akarelas

akarelas solutions to challenge 281

2 files changed, 73 insertions, 0 deletions

diff --git a/challenge-281/alexander-karelas/perl/ch-1.pl b/challenge-281/alexander-karelas/perl/ch-1.pl
new file mode 100755
index 0000000000..b346ce200d
--- /dev/null
+++ b/challenge-281/alexander-karelas/perl/ch-1.pl
@@ -0,0 +1,18 @@
+#!/usr/bin/env perl
+
+use v5.40;
+
+use Test::More;
+
+sub do_it ($coordinates) {
+    if ($coordinates eq 'a1') { return false; }
+    my ($letter, $number) = $coordinates =~ /^(.)(.)\z/;
+    my $parity = (ord($letter) - ord('a') + $number - 1) % 2;
+    return $parity ^^ do_it('a1');
+}
+
+is do_it('d3'), true, 'Example 1';
+is do_it('g5'), false, 'Example 2';
+is do_it('e6'), true, 'Example 3';
+
+done_testing();
\ No newline at end of file
diff --git a/challenge-281/alexander-karelas/perl/ch-2.pl b/challenge-281/alexander-karelas/perl/ch-2.pl
new file mode 100755
index 0000000000..37007951f0
--- /dev/null
+++ b/challenge-281/alexander-karelas/perl/ch-2.pl
@@ -0,0 +1,55 @@
+#!/usr/bin/env perl
+
+use v5.40;
+
+use Test::More;
+
+use List::Util 'all';
+
+my %covered;
+sub is_covered ($coordinates) {
+    return exists $covered{join '', @$coordinates};
+}
+
+sub get_value ($coordinates) {
+    return $covered{join '', @$coordinates};
+}
+
+sub possible_moves ($square) {
+    my @ret;
+    foreach my $main_axis (0, 1) {
+        foreach my $fora (1, -1) {
+            foreach my $secondary_fora (1, -1) {
+                my @dest = @$square;
+                $dest[$main_axis] += 2 * $fora;
+                $dest[1 - $main_axis] += $secondary_fora;
+                all { 1 <= $_ <= 8 } @dest or next;
+                push @ret, \@dest;
+            }
+        }
+    }
+    return @ret;
+}
+
+sub do_it ($start, $end) {
+    # pre-process
+    foreach my $coordinates ($start, $end) {
+        my ($letter, $number) = $coordinates =~ /^(.)(.)\z/;
+        $coordinates = [1 + ord($letter) - ord('a'), $number];
+    }
+    %covered = (join('', @$start) => 0);
+
+    my @queue = ($start);
+    while (my $square = shift @queue) {
+        my $square_value = get_value($square);
+        join('', @$square) ne join('', @$end) or return $square_value;
+        my @possible_moves = grep !is_covered($_), possible_moves($square);
+        push @queue, @possible_moves;
+        $covered{join '', @$_} = $square_value + 1 foreach @possible_moves;
+    }
+}
+
+is do_it('g2', 'a8'), 4, 'Example 1';
+is do_it('g2', 'h2'), 3, 'Example 2';
+
+done_testing();
\ No newline at end of file