Merge pull request #1589 from jaredor/new-branch

New branch

5 files changed, 141 insertions, 0 deletions

diff --git a/challenge-055/jaredor/blog.txt b/challenge-055/jaredor/blog.txt
new file mode 100644
index 0000000000..ca6056c914
--- /dev/null
+++ b/challenge-055/jaredor/blog.txt
@@ -0,0 +1 @@
+http://blogs.perl.org/users/jared_martin/2020/04/pwc-055-task-1-flip-binary.html
diff --git a/challenge-055/jaredor/blog1.txt b/challenge-055/jaredor/blog1.txt
new file mode 100644
index 0000000000..341dad4caf
--- /dev/null
+++ b/challenge-055/jaredor/blog1.txt
@@ -0,0 +1 @@
+http://blogs.perl.org/users/jared_martin/2020/04/pwc-055-task-2-wave-array.html
diff --git a/challenge-056/jaredor/blog.txt b/challenge-056/jaredor/blog.txt
new file mode 100644
index 0000000000..bbed8fa8da
--- /dev/null
+++ b/challenge-056/jaredor/blog.txt
@@ -0,0 +1 @@
+http://blogs.perl.org/users/jared_martin/2020/04/pwc-056-task-1-diff-k-task-2-path-sum.html

diff --git a/challenge-056/jaredor/perl/pwc056t1.pl b/challenge-056/jaredor/perl/pwc056t1.pl
new file mode 100755
index 0000000000..64e81a8c49
--- /dev/null
+++ b/challenge-056/jaredor/perl/pwc056t1.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Getopt::Long;
+use List::Util qw(all);
+
+# PWC 056, Task #1
+
+Getopt::Long::Configure( 'bundling_values', 'ignorecase_always',
+    'pass_through' );
+
+my $difference;
+GetOptions( 'k=i' => \$difference ) or die "Problem with GetOptions.";
+
+# "non negative integer k"
+
+die "The --k option must be non-negative: $difference" unless $difference >= 0;
+
+# "array @N of positive integers (sorted)"
+# The following approach does not require input array to be sorted.
+
+my @N = @ARGV;
+die "Some arguments are not positive integers."
+  unless all { $_ =~ /\A [1-9] \d* \Z/xms } @N;
+
+my %M;
+push @{ $M{ $N[$_] } }, $_ for 0 .. $#N;
+
+my ( @answer, @output );
+
+if ($difference) {
+    @answer = grep { exists $M{$_} } map { $_ - $difference } keys %M;
+    for my $subtrahend (@answer) {
+        my $minuend = $subtrahend + $difference;
+        for my $minidx ( @{ $M{$minuend} } ) {
+            for my $subidx ( @{ $M{$subtrahend} } ) {
+                push @output, [ $minidx, $subidx ];
+            }
+        }
+    }
+}
+else {
+    @answer = grep { @{ $M{$_} } > 1 } keys %M;
+    for my $dup (@answer) {
+        for my $idx1 ( 0 .. ( $#{ $M{$dup} } - 1 ) ) {
+            for my $idx2 ( ( $idx1 + 1 ) .. $#{ $M{$dup} } ) {
+                push @output, [ $M{$dup}->[$idx1], $M{$dup}->[$idx2] ];
+            }
+        }
+    }
+}
+
+print join( ',', @$_ ), "\n"
+  for sort { $a->[0] <=> $b->[0] or $a->[1] <=> $b->[1] } @output;
diff --git a/challenge-056/jaredor/perl/pwc056t2.pl b/challenge-056/jaredor/perl/pwc056t2.pl
new file mode 100755
index 0000000000..92d852265b
--- /dev/null
+++ b/challenge-056/jaredor/perl/pwc056t2.pl
@@ -0,0 +1,84 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Getopt::Long;
+use List::Util qw(all sum);
+use Scalar::Util qw(looks_like_number);
+
+# PWC 056, Task #2
+
+# The binary tree will be input as the argument array to the script.
+# Any argument perl does not think is a number will be considered a null
+# element, i.e., not a node in the tree.
+
+my @N = map { looks_like_number $_ ? 0 + $_ : undef } @ARGV;
+
+my @node;
+
+my ( $i, $prevtree ) = ( 0, 1 );
+
+$node[$i] = [ undef, undef, $N[$i] ];
+
+for $i ( 1 .. $#N ) {
+
+    $prevtree = 2 * $prevtree - 1 if $i > 2 * ( $prevtree + 1 );
+    my $parentidx = $prevtree - 1 + int( ( $i - $prevtree ) / 2 );
+
+    if ( defined $N[$i] ) {
+        die "Not a binary tree. The parent node to element $i does not exist."
+          if not defined $N[$parentidx];
+        $node[$i] = [ undef, undef, $N[$i] ];
+        $node[$parentidx]->[ ( $i + 1 ) % 2 ] = $node[$i];
+    }
+}
+my $btree = $node[0];
+undef @node;
+
+# Okay we have a binary tree. Find the sums.
+# We could have done that earlier, when importing the tree,
+# but that would have been cheating ;-)
+
+my %sums;
+
+sub walk_btree {
+    my ( $btree, $path ) = @_;
+    my $path_next = [ @$path, $btree->[2] ];
+    walk_btree( $btree->[0], $path_next ) if defined $btree->[0];
+    walk_btree( $btree->[1], $path_next ) if defined $btree->[1];
+    push @{ $sums{ sum @$path_next } }, $path_next
+      if not( defined $btree->[0] or defined $btree->[1] );
+}
+
+walk_btree( $btree, [] );
+
+# Now entertain the user with pre-computed answers.
+
+my ( $sep, $user_input ) = ( ' → ', '' );
+
+my @seek;
+while ( $user_input !~ /\A \s* [Qq] /xms ) {
+    print "\nEnter sum to seek. (<ENTER> returns all sums, [Qq]uit): ";
+    $user_input = <STDIN>;
+    chomp $user_input;
+    if ( $user_input =~ /\A \s* \Z/xms ) {
+        @seek = sort { $b <=> $a } keys %sums;
+    }
+    elsif ( looks_like_number $user_input ) {
+        @seek = ( 0 + $user_input );
+    }
+    while (@seek) {
+        my $sum = pop @seek;
+        if ( exists $sums{$sum} ) {
+            my ( $noun, $verb ) =
+              @{ $sums{$sum} } > 1 ? ( 's', '' ) : ( '', 's' );
+            my $leader = "Path$noun that sum$verb to $sum:";
+            my $llen   = length $leader;
+            print "\n";
+            printf( "%${llen}s %s\n", $leader, join( $sep, @$_ ) ), $leader = ''
+              for @{ $sums{$sum} };
+        }
+        else {
+            print "\nNo path sums to $sum.\n";
+        }
+    }
+}