Solution for PWC 077, Task 2 Lonely X

8 files changed, 295 insertions, 33 deletions

diff --git a/challenge-077/bob-lied/perl/ch-1.pl b/challenge-077/bob-lied/perl/ch-1.pl
index faf73a1f34..71514fddde 100755
--- a/challenge-077/bob-lied/perl/ch-1.pl
+++ b/challenge-077/bob-lied/perl/ch-1.pl
@@ -20,16 +20,24 @@ use feature qw/ signatures /;
 no warnings qw/ experimental::signatures /;
 
 use lib "lib";
-use FibSum;
+use FibSum qw(_fib);
 
-sub Usage { "Usage: $0 args" };
+# The biggest Fibonacci number that fits in an integer is f(93).
+# That's way overkill -- only N up to about 3 digits is reasonable.
+my $N_MAX = _fib(93);
 
-my $arg = shift;
-my @list = @ARGV;
+sub Usage { "Usage: $0 N\n\t0 < N < 10000" };
 
-die Usage() unless $arg;
-die Usage() unless @list;
+my $N = shift;
 
-my $task = FibSum->new();
+die Usage() unless $N;
+die Usage() unless 0 < $N && $N <= $N_MAX;
+
+my $task = FibSum->new($N);
 my $result = $task->run();
-say $result;
+
+# Result is an array of arrays.
+for my $answer ( @$result )
+{
+    say join(' + ', sort { $a <=> $b } @$answer), " = $N";
+}
diff --git a/challenge-077/bob-lied/perl/ch-2.pl b/challenge-077/bob-lied/perl/ch-2.pl
index 5b945a61b7..5c959b0085 100755
--- a/challenge-077/bob-lied/perl/ch-2.pl
+++ b/challenge-077/bob-lied/perl/ch-2.pl
@@ -24,17 +24,26 @@ use v5.30;
 use feature qw/ signatures /;
 no warnings qw/ experimental::signatures /;
 
+use Getopt::Long;
+
 use lib "lib";
 use LonelyX;
 
-sub Usage { "Usage: $0 args" };
+sub Usage { "Usage: $0 path-to-matrix" };
+
+my $Verbose = 0;
+GetOptions("verbose" => \$Verbose);
 
-my $arg = shift;
-my @list = @ARGV;
+my $path = shift;
 
-die Usage() unless $arg;
-die Usage() unless @list;
+die Usage() unless $path;
+die (Usage() ." ". $!) unless -r $path;
 
-my $task = LonelyX->new();
-my $result = $task->run();
+my $lx = LonelyX->new();
+$lx->loadGrid($path);
+$lx->showGrid() if ( $Verbose );
+
+my $result = $lx->run();
 say $result;
+
+$lx->highlight() if ( $Verbose )
diff --git a/challenge-077/bob-lied/perl/lib/FibSum.pm b/challenge-077/bob-lied/perl/lib/FibSum.pm
index 06c02d150e..d7ad2de06c 100644
--- a/challenge-077/bob-lied/perl/lib/FibSum.pm
+++ b/challenge-077/bob-lied/perl/lib/FibSum.pm
@@ -12,26 +12,121 @@ package FibSum;
 use strict;
 use warnings;
 
+use v5.30;
+use feature qw/ signatures /;
+no warnings qw/ experimental::signatures /;
+
+use Memoize;
+
 require Exporter;
 our @ISA = qw(Exporter);
 our @EXPORT = qw();
-our @EXPORT_OK = qw();
+our @EXPORT_OK = qw(_fib);  # Not part of interface, but expose for testing.
+
+my @ComboList;
+
+use constant SOLVED => 0;
+
+# The poster child for Memoize.
+memoize('_fib');
+sub _fib($n)
+{
+    return $n if $n < 2;
+    return _fib($n-1) + _fib($n-2);
+}
 
-sub new
+# Create a list of Fibonacci numbers that are less than
+# the target, in descending order.
+sub _init($target)
+{
+    my $f;
+    my @fl  = ( 1 );    # Take for granted.
+    my $n = 3;          # We can skip 2 because F(2) == 1.
+    while ( ($f = _fib($n)) <= $target )
+    {
+        push @fl, $f;
+        $n++;
+    }
+
+    return [ reverse @fl ];  # Descending order
+}
+
+# Constructor.   Save target and initialize list of
+# Fibonacci numbers that can be used to sum to the target.
+sub new($class, $n)
 {
-    my $class = shift;
     $class = ref($class) || $class;
     my $self = {
-        _name1 => $_[0],
+        _n => $n,
+
+        _f => [],   # List of Fibonacci numbers less than _n
     };
+    $self->{_f} = _init($n);
     bless $self, $class;
-    return $self;
 }
 
-sub run
+# Accessor.  Should have used Moo.
+sub target($self)
 {
-    my $self = shift;
-    return undef;
+    return $self->{_n};
+}
+
+# Accessor.
+sub getFibList($self)
+{
+    return $self->{_f};
+}
+
+# Entry point.
+sub run($self)
+{
+    my @fibs = @{$self->getFibList()};
+    @ComboList = ();
+
+    while ( @fibs )
+    {
+        # say "WORKING ON [ @fibs ]";
+        $self->_fibSum(1, $self->target(), \@fibs, $fibs[0], [ $fibs[0] ] );
+        shift @fibs;
+    }
+    return \@ComboList;
+}
+
+# Recursive magic. $depth is only here for debugging.
+sub _fibSum($self, $depth, $target, $fibList, $fib, $combo)
+{
+    # say " ", (" " x $depth), "$depth: t=$target, f=$fib, [ @$combo ]";
+    my $diff = $target - $fib;
+
+    if ( $diff == 0 )
+    {
+        # Found an answer.  Save it.
+        push @ComboList, [ @$combo ];
+        return SOLVED;
+    }
+    if ( $diff < 0 )
+    {
+        # Too big.  Give up.
+        pop @$combo;
+        return $diff;
+    }
+
+    # Only allowed to use fib once
+    my @remainingFib = grep { $_ != $fib && $_ <= $diff } @$fibList;
+
+    for my $f ( @remainingFib )
+    {
+        push @$combo, $f;   # Build up the answer.
+
+        # Look for the new, smaller, target number.
+        my $attempt = $self->_fibSum($depth+1, $diff, \@remainingFib, $f, $combo);
+        pop @$combo;        # Put that one away and go to the next.
+
+        # If we found a solution, we don't need to go through other
+        # possibilities because of the constraint to use each Fn only once.
+        return 0 if $attempt == SOLVED;
+    }
+    return $diff;
 }
 
 1;
diff --git a/challenge-077/bob-lied/perl/lib/LonelyX.pm b/challenge-077/bob-lied/perl/lib/LonelyX.pm
index c93169b342..6245df6089 100644
--- a/challenge-077/bob-lied/perl/lib/LonelyX.pm
+++ b/challenge-077/bob-lied/perl/lib/LonelyX.pm
@@ -11,27 +11,145 @@ package LonelyX;
 
 use strict;
 use warnings;
+use v5.30;
+
+use feature qw/ signatures /;
+no warnings qw/ experimental::signatures /;
+
+use File::Slurper qw/ read_lines /;
+use List::Util    qw/ all /;
 
 require Exporter;
 our @ISA = qw(Exporter);
 our @EXPORT = qw();
 our @EXPORT_OK = qw();
 
-sub new
+sub new($class, @args)
 {
-    my $class = shift;
     $class = ref($class) || $class;
     my $self = {
-        _name1 => $_[0],
+        _grid => [],
+        _lastRow => 0,
+        _lastCol => 0,
+
+        _lonelyPosition => [],
     };
     bless $self, $class;
     return $self;
 }
 
-sub run
+sub run($self)
+{
+    my $g = $self->{_grid};
+    my $lastRow = $self->{_lastRow};
+    my $lastCol = $self->{_lastCol};
+    my $pos = $self->{_lonelyPosition};
+    my $count = 0;
+
+    # We put a border of Os around so we can walk around
+    # an inner rectangle without constantly having to check
+    # for border conditions
+    for my $row ( 1 .. ($lastRow-1) )
+    {
+        for my $col ( 1 .. ($lastCol-1) )
+        {
+            next unless $g->[$row][$col] eq 'X';
+            if ( $self->isLonely($row, $col) )
+            {
+                $count++;
+                push @{$pos}, [ $row, $col ];
+            }
+        }
+    }
+    return $count;
+}
+
+sub getPosition($self)
+{
+    return $self->{_lonelyPosition};
+}
+
+sub highlight($self)
+{
+    my $grid = $self->{_grid};
+    my $lastRow = $self->{_lastRow};
+    my $lastCol = $self->{_lastCol};
+    my $pos = $self->{_lonelyPosition};
+
+    # Make a deep copy of the grid so that we can change
+    # the characters in it.
+    my @g;
+    for my $row ( 0 .. $lastRow )
+    {
+        for my $col ( 0 .. $lastCol )
+        {
+            if ( $grid->[$row][$col] eq 'O' )
+            {
+                $g[$row][$col] = '.';
+            }
+            else
+            {
+                $g[$row][$col] = '*';
+            }
+        }
+    }
+    for my $p ( @$pos )
+    {
+        my ($r, $c) = @$p;
+        $g[$r][$c] = 'X';
+    }
+    # Drop the border for display
+    shift @g;
+    pop @g;
+    for my $row ( @g )
+    {
+        shift @$row; pop @$row;
+        say "[ ", join(" ", @$row), " ]";
+    }
+}
+
+sub isLonely($self, $row, $col)
+{
+    my $g = $self->{_grid};
+
+    my @neighbors = ( @{$g->[$row-1]}[$col -1, $col, $col+1],
+                      @{$g->[$row  ]}[$col -1,       $col+1],
+                      @{$g->[$row+1]}[$col -1, $col, $col+1] );
+
+    my $isLonely = List::Util::all { $_ eq 'O' } @neighbors;
+    return $isLonely;
+}
+
+sub loadGrid($self, $path)
+{
+    my $g = $self->{_grid};
+
+    my @txt = File::Slurper::read_lines($path);   
+    for my $line (@txt)
+    {
+        $line =~ tr/[]//d;
+        my @row = split(" ", $line);
+        # Put a border of zeroes around the grid
+        push @{$g}, [ 'O', @row, 'O' ];
+    }
+
+    my @zeroRow = (('O') x scalar(@{$g->[0]}) );
+    
+    unshift @$g, \@zeroRow;
+    push    @$g, \@zeroRow;
+    
+    # Save dimensions
+    $self->{_lastRow} = scalar(@$g) - 1;
+    $self->{_lastCol} = scalar( @{$g->[0]} ) -1;
+}
+
+sub showGrid($self)
 {
-    my $self = shift;
-    return undef;
+    my $g = $self->{_grid};
+    for my $row ( @$g )
+    {
+        say "[ ", join(" ", @$row), " ]";
+    }
 }
 
 1;
diff --git a/challenge-077/bob-lied/perl/t/FibSum.t b/challenge-077/bob-lied/perl/t/FibSum.t
index 26fff3b59e..75b74c57aa 100644
--- a/challenge-077/bob-lied/perl/t/FibSum.t
+++ b/challenge-077/bob-lied/perl/t/FibSum.t
@@ -11,9 +11,30 @@ use v5.30;
 
 use Test2::V0;
 
-use FibSum;
+use FibSum qw(_fib);
+
+is( _fib( 0),         0, "f(0)");
+is( _fib( 1),         1, "f(1)");
+is( _fib( 2),         1, "f(2)");
+is( _fib( 3),         2, "f(3)");
+is( _fib( 4),         3, "f(4)");
+is( _fib(10),        55, "f(10)");
+is( _fib(20),      6765, "f(20)");
+is( _fib(30),    832040, "f(30)");
+is( _fib(40), 102334155, "f(40)");
+is( _fib(93), 12200160415121876738, "f(93)");
+
+my $fsum = FibSum->new(6);
+isa_ok($fsum, [ "FibSum" ], "Constructor");
+
+my $fibList = $fsum->getFibList();
+is( $fibList, [ 5, 3, 2, 1 ], "fibList for 6" );
+is( $fsum->target(), 6,       "target for 6" );
+
+is( $fsum->run(), [ [ 5, 1], [ 3, 2, 1] ], "FibSum(6)" );
+
+is( FibSum->new(9)->run(), [ [8, 1], [5, 3, 1] ], "FibSum(9)");
+
 
-my $fsum = FibSum->new();
-isa_ok($fsum, "FibSum", "Constructor");
 
 done_testing();
diff --git a/challenge-077/bob-lied/perl/t/LonelyX.t b/challenge-077/bob-lied/perl/t/LonelyX.t
index e0cc63b4a9..0e5ee08f8d 100644
--- a/challenge-077/bob-lied/perl/t/LonelyX.t
+++ b/challenge-077/bob-lied/perl/t/LonelyX.t
@@ -14,6 +14,10 @@ use Test2::V0;
 use LonelyX;
 
 my $lx = LonelyX->new();
-isa_ok($ls, "LonelyX", "Constructor");
+isa_ok($lx, "LonelyX", "Constructor");
+
+$lx->loadGrid("t/example1.txt");
+is($lx->{_lastRow}, 2, "loadGrid rows");
+is($lx->{_lastCol}, 2, "loadGrid cols");
 
 done_testing();
diff --git a/challenge-077/bob-lied/perl/t/example1.txt b/challenge-077/bob-lied/perl/t/example1.txt
new file mode 100644
index 0000000000..f6034dc2f3
--- /dev/null
+++ b/challenge-077/bob-lied/perl/t/example1.txt
@@ -0,0 +1,3 @@
+[ O O X ]
+[ X O O ]
+[ X O O ]
diff --git a/challenge-077/bob-lied/perl/t/example2.txt b/challenge-077/bob-lied/perl/t/example2.txt
new file mode 100644
index 0000000000..723198205d
--- /dev/null
+++ b/challenge-077/bob-lied/perl/t/example2.txt
@@ -0,0 +1,4 @@
+[ O O X O ]
+[ X O O O ]
+[ X O O X ]
+[ O X O O ]