Merge pull request #2262 from boblied/master

PWC 077 Solution for Fibonacci Sum and Lonely X

9 files changed, 453 insertions, 52 deletions

diff --git a/challenge-077/bob-lied/README b/challenge-077/bob-lied/README
index e3712fbb10..9deeb88045 100644
--- a/challenge-077/bob-lied/README
+++ b/challenge-077/bob-lied/README
@@ -1,53 +1,3 @@
-Solutions to weekly challenge 74 by Bob Lied.
+Solutions to weekly challenge 77 by Bob Lied.
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-074/
-
-* TASK #1 > Majority Element
-
-** Initial thoughts
-
-This is going to be an exercise in hashes and grep.
-
-** Post Solution Thoughts
-
-Use a hash to count to count elements, then use grep with a code block to select the match.
-
-** Problem Statement
-
-You are given an array of integers of size $N.
-Write a script to find the majority element. If none found then print -1.
-Majority element in the list is the one that appears more than floor(size_of_list/2).
-
-
-
-* TASK #2 > FNR Character
-
-** Initial Thoughts
-
-The specification is a little odd and doesn't match the example.  But, OK, whatever.
-Similar to the first task, another hash to count occurrences and grep to find the answers.
-
-** Post Solution Thoughts
-
-Going through the string could be either done with substr one character at a time,
-or splitting the string into an array of characters.  Finding the first char could be
-a search through the character positions, or a sort and picking off the first element.
-Sort is the easy answer, but I'm always wary of scaling.  Like in many of these
-problems, it's not an issue for "reasonable" strings, but could become a performance
-question if the strings were a thousand or a million times bigger.
-
-
-** Problem Statement
-
-You are given a string $S.
-
-Write a script to print the series of first non-repeating character
-(left -> right) for the given string. Print # if none found.
-Example 1
-Input: $S = ‘ababc’
-Output: ‘abb#c’
-Pass 1: “a”, the FNR character is ‘a’
-Pass 2: “ab”, the FNR character is ‘b’
-Pass 3: “aba”, the FNR character is ‘b’
-Pass 4: “abab”, no FNR found, hence ‘#’
-Pass 5: “ababc” the FNR character is ‘c’
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-077/
diff --git a/challenge-077/bob-lied/perl/ch-1.pl b/challenge-077/bob-lied/perl/ch-1.pl
new file mode 100755
index 0000000000..71514fddde
--- /dev/null
+++ b/challenge-077/bob-lied/perl/ch-1.pl
@@ -0,0 +1,43 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl
+#=============================================================================
+# Copyright (c) 2020, Bob Lied
+#=============================================================================
+# Perl Weekly Challenge 077 Task #1 > Fibonacci Sum
+#=============================================================================
+# You are given a positive integer $N.
+# Write a script to find out all possible combination of Fibonacci Numbers
+# required to get $N on addition.
+# You are NOT allowed to repeat a number. Print 0 if none found.
+
+use strict;
+use warnings;
+use v5.30;
+
+use feature qw/ signatures /;
+no warnings qw/ experimental::signatures /;
+
+use lib "lib";
+use FibSum qw(_fib);
+
+# 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);
+
+sub Usage { "Usage: $0 N\n\t0 < N < 10000" };
+
+my $N = shift;
+
+die Usage() unless $N;
+die Usage() unless 0 < $N && $N <= $N_MAX;
+
+my $task = FibSum->new($N);
+my $result = $task->run();
+
+# 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
new file mode 100755
index 0000000000..5c959b0085
--- /dev/null
+++ b/challenge-077/bob-lied/perl/ch-2.pl
@@ -0,0 +1,49 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl
+#=============================================================================
+# Copyright (c) 2020, Bob Lied
+#=============================================================================
+# Perl Weekly Challenge 077 Task #2 > Lonely X
+#=============================================================================
+# You are given m x n character matrix consists of O and X only.
+# Write a script to count the total number of X surrounded by O only.
+# Print 0 if none found.
+# Example 1:
+# Input: [ O O X ]
+#        [ X O O ]
+#        [ X O O ]
+#
+# Output: 1 as there is only one X at the first row last column surrounded by only O.
+
+use strict;
+use warnings;
+use v5.30;
+
+use feature qw/ signatures /;
+no warnings qw/ experimental::signatures /;
+
+use Getopt::Long;
+
+use lib "lib";
+use LonelyX;
+
+sub Usage { "Usage: $0 path-to-matrix" };
+
+my $Verbose = 0;
+GetOptions("verbose" => \$Verbose);
+
+my $path = shift;
+
+die Usage() unless $path;
+die (Usage() ." ". $!) unless -r $path;
+
+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
new file mode 100644
index 0000000000..d7ad2de06c
--- /dev/null
+++ b/challenge-077/bob-lied/perl/lib/FibSum.pm
@@ -0,0 +1,133 @@
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# FibSum.pm
+#=============================================================================
+# Copyright (c) 2020, Bob Lied
+#=============================================================================
+# Description:
+#=============================================================================
+
+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(_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);
+}
+
+# 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)
+{
+    $class = ref($class) || $class;
+    my $self = {
+        _n => $n,
+
+        _f => [],   # List of Fibonacci numbers less than _n
+    };
+    $self->{_f} = _init($n);
+    bless $self, $class;
+}
+
+# Accessor.  Should have used Moo.
+sub target($self)
+{
+    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
new file mode 100644
index 0000000000..6245df6089
--- /dev/null
+++ b/challenge-077/bob-lied/perl/lib/LonelyX.pm
@@ -0,0 +1,156 @@
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# LonelyX.pm
+#=============================================================================
+# Copyright (c) 2020, Bob Lied
+#=============================================================================
+# Description:
+#=============================================================================
+
+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($class, @args)
+{
+    $class = ref($class) || $class;
+    my $self = {
+        _grid => [],
+        _lastRow => 0,
+        _lastCol => 0,
+
+        _lonelyPosition => [],
+    };
+    bless $self, $class;
+    return $self;
+}
+
+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 $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
new file mode 100644
index 0000000000..75b74c57aa
--- /dev/null
+++ b/challenge-077/bob-lied/perl/t/FibSum.t
@@ -0,0 +1,40 @@
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#
+#===============================================================================
+# FILE: FibSum.t
+# DESCRIPTION: Unit test for FibSum
+#===============================================================================
+
+use strict;
+use warnings;
+use v5.30;
+
+use Test2::V0;
+
+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)");
+
+
+
+done_testing();
diff --git a/challenge-077/bob-lied/perl/t/LonelyX.t b/challenge-077/bob-lied/perl/t/LonelyX.t
new file mode 100644
index 0000000000..0e5ee08f8d
--- /dev/null
+++ b/challenge-077/bob-lied/perl/t/LonelyX.t
@@ -0,0 +1,23 @@
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#
+#===============================================================================
+# FILE: LonelyX.t
+# DESCRIPTION: Unit test for LonelyX
+#===============================================================================
+
+use strict;
+use warnings;
+use v5.30;
+
+use Test2::V0;
+
+use LonelyX;
+
+my $lx = LonelyX->new();
+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 ]