Merge pull request #2439 from boblied/master

Solutions for PWC 080

5 files changed, 185 insertions, 7 deletions

diff --git a/challenge-079/bob-lied/perl/lib/CountSetBit.pm b/challenge-079/bob-lied/perl/lib/CountSetBit.pm
index 1733d4e676..068be81e2a 100644
--- a/challenge-079/bob-lied/perl/lib/CountSetBit.pm
+++ b/challenge-079/bob-lied/perl/lib/CountSetBit.pm
@@ -1,3 +1,4 @@
+## Please see file perltidy.ERR
 # vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
 #=============================================================================
 # CountSetBit.pm
@@ -17,18 +18,17 @@ use feature qw/ signatures /;
 no warnings qw/ experimental::signatures /;
 
 require Exporter;
-our @ISA = qw(Exporter);
-our @EXPORT = qw();
+our @ISA       = qw(Exporter);
+our @EXPORT    = qw();
 our @EXPORT_OK = qw();
 
-sub new($class, $n)
+sub new ( $class, $n )
 {
     $class = ref($class) || $class;
     my $self = {
         _n => $n,
 
-        _sum => 0,
-    };
+        _sum => 0, };
     bless $self, $class;
     return $self;
 }
@@ -40,14 +40,14 @@ sub run($self)
     return ( $self->{_sum} % 1000000007 );
 }
 
-sub _bitsOf($self, $n)a
+sub _bitsOf ( $self, $n )
 {
     my $count = 0;
 
     while ( $n > 0 )
     {
         $count++;
-        $n = $n & ($n-1);
+        $n = $n & ( $n - 1 );
     }
     return $count;
 }
diff --git a/challenge-080/bob-lied/perl/ch-1.pl b/challenge-080/bob-lied/perl/ch-1.pl
new file mode 100755
index 0000000000..8323c7b227
--- /dev/null
+++ b/challenge-080/bob-lied/perl/ch-1.pl
@@ -0,0 +1,38 @@
+#!/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 080 Task #1 > Smallest Positive Number
+#=============================================================================
+# You are given unsorted list of integers @N.
+# Write a script to find out the smallest positive number missing.
+
+use strict;
+use warnings;
+use v5.30;
+
+use feature qw/ signatures /;
+no warnings qw/ experimental::signatures /;
+
+use Getopt::Long;
+
+use lib "lib";
+use SmallestPositive;
+
+sub Usage { "Usage: $0 args" };
+
+my $Verbose = 0;
+GetOptions('verbose' => \$Verbose);
+
+# Allow anything that looks like a list as arguments
+(my $argv = "@ARGV") =~ s/[,()]/ /g;
+my @N = split(" ", $argv);
+
+die "Usage: $0 list-of-integers" unless @N;
+
+my $task = SmallestPositive->new(\@N);
+my $result = $task->run();
+say $result;
diff --git a/challenge-080/bob-lied/perl/ch-2.pl b/challenge-080/bob-lied/perl/ch-2.pl
new file mode 100755
index 0000000000..91db2d620b
--- /dev/null
+++ b/challenge-080/bob-lied/perl/ch-2.pl
@@ -0,0 +1,44 @@
+#!/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 080 Task #2 > Count Candies 
+#=============================================================================
+# You are given rankings of @N candidates.
+# Write a script to find out the toal candies needed for all candidates.
+# You are asked to follow the rules below:
+# a) You must give at least one candy to each candidate.
+# b) Candidate with higher ranking get more candies then ther immediate
+#    neighbors on either side.
+
+use strict;
+use warnings;
+use 5.030;
+
+use feature qw/ signatures /;
+no warnings qw/ experimental::signatures /;
+
+use List::Util qw/ sum /;
+
+my @candidate;
+
+# Allow anything that looks like a list as arguments
+(my $argv = "@ARGV") =~ s/[,()]/ /g;
+@candidate = split(" ", $argv);
+
+die "Usage: $0 list-of-numbers" unless @candidate;
+
+
+# Make the boundaries easy by adding left and right elements that
+# won't add to the total.
+unshift @candidate, $candidate[ 0];
+push    @candidate, $candidate[-1];
+
+sub candy($left, $me, $right) { return 1 + ($me > $left) + ($me > $right); }
+
+# range of indexes excludes first and last element
+my $score = sum map { candy(@candidate[ (($_-1), $_, ($_+1) ) ]) } ( 1 .. ($#candidate-1) );
+say "$score";
diff --git a/challenge-080/bob-lied/perl/lib/SmallestPositive.pm b/challenge-080/bob-lied/perl/lib/SmallestPositive.pm
new file mode 100644
index 0000000000..f2a4d9635c
--- /dev/null
+++ b/challenge-080/bob-lied/perl/lib/SmallestPositive.pm
@@ -0,0 +1,66 @@
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# SmallestPositive.pm
+#=============================================================================
+# Copyright (c) 2020, Bob Lied
+#=============================================================================
+# Description:
+#=============================================================================
+
+package SmallestPositive;
+
+use strict;
+use warnings;
+use v5.30;
+
+use feature qw/ signatures /;
+no warnings qw/ experimental::signatures /;
+
+use List::MoreUtils qw/ firstidx /;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw();
+our @EXPORT_OK = qw();
+
+sub new($class, @N)
+{
+    $class = ref($class) || $class;
+    my $self = {
+    };
+    bless $self, $class;
+
+    # Clean up the list to have only positive numbers in sorted order
+    $self->{_N} = [ sort { $a <=> $b } grep $_ > 0, @N ];
+    return $self;
+}
+
+sub run($self)
+{
+    my @n = @{$self->{_N}};
+
+    # Weed out some special cases.
+    if ( @n == 0 ) # Empty list
+    {
+        return 1;
+    }
+    elsif ( @n == 1 )
+    {
+        return ($n[0] == 1 ? 2 : 1);
+    }
+
+    # Put a lower bound and upper bound on the list.
+    unshift @n, 0;
+    push @n, ($n[-1] + 2);
+
+    # Calculate differences between pairs.
+    my @delta = map { $n[$_+1] - $n[$_] } ( 0 .. $#n-1 );
+    
+    # Find the first difference that isn't 1.  We rigged the list
+    # to have a +2 at the right end, so there must be one.
+    my $place = firstidx { $_ > 1 } @delta;
+
+    return $n[$place] + 1;
+}
+
+1;
diff --git a/challenge-080/bob-lied/perl/t/SmallestPositive.t b/challenge-080/bob-lied/perl/t/SmallestPositive.t
new file mode 100644
index 0000000000..e9bacd158d
--- /dev/null
+++ b/challenge-080/bob-lied/perl/t/SmallestPositive.t
@@ -0,0 +1,30 @@
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#
+#===============================================================================
+# FILE: SmallestPositive.t
+# DESCRIPTION: Unit test for SmallestPositive
+#===============================================================================
+
+use strict;
+use warnings;
+use v5.30;
+
+use Test2::V0;
+
+use SmallestPositive;
+
+my $sp = SmallestPositive->new( 5, 2, -2, 0 );
+isa_ok($sp, [ qw(SmallestPositive) ], "Constructor" );
+is( $sp->{_N}, [ 2,5 ],               "Initialization" );
+
+is( SmallestPositive->new(-2)->run(),            1, "Empty list" );
+is( SmallestPositive->new(-2, 1)->run(),         2, "list=(1)" );
+is( SmallestPositive->new(-2, 2)->run(),         1, "list=(2)" );
+is( SmallestPositive->new(5, 2, -2, 0)->run(),   1, "list=(5)" );
+is( SmallestPositive->new(1, 8, -1)->run(),      2, "list=(8)" );
+is( SmallestPositive->new(1, 2, 3)->run(),       4, "sequence" );
+is( SmallestPositive->new(10, 20, 30)->run(),    1, "holes" );
+is( SmallestPositive->new( (1..50), 52)->run(), 51, "list(50)" );
+is( SmallestPositive->new( (-7..-1) )->run(),    1, "negative" );
+
+done_testing();