Merge pull request #1691 from jaredor/pwc059

Pwc059

3 files changed, 106 insertions, 0 deletions

diff --git a/challenge-059/jaredor/blog.txt b/challenge-059/jaredor/blog.txt
new file mode 100644
index 0000000000..5b7a3e390d
--- /dev/null
+++ b/challenge-059/jaredor/blog.txt
@@ -0,0 +1 @@
+http://blogs.perl.org/users/jared_martin/2020/05/pwc-059-task-1-linked-list-task-2-bit-sum.html
diff --git a/challenge-059/jaredor/perl/ch-1.pl b/challenge-059/jaredor/perl/ch-1.pl
new file mode 100755
index 0000000000..14a277516d
--- /dev/null
+++ b/challenge-059/jaredor/perl/ch-1.pl
@@ -0,0 +1,67 @@
+#!/usr/bin/env perl
+
+use v5.012;
+use warnings;
+use Getopt::Long;
+use List::Util qw(all);
+use Scalar::Util qw(looks_like_number);
+
+# PWC 059, TASK #1 : Linked List
+
+Getopt::Long::Configure( 'bundling_values', 'ignorecase_always',
+    'pass_through' );
+
+GetOptions( 'k=f' => \( my $k ) );
+
+die "The --k option must set a numeric value for the partitioning definition."
+  unless looks_like_number $k;
+
+die "The link values of the linked list must all be numeric."
+  unless all { looks_like_number $_ } @ARGV;
+
+die "No link values provided for the linked list."
+  unless @ARGV;
+
+# Convenience constructs.
+
+use constant NULL => [];
+sub make_link { return [ $_[0], NULL ]; }
+
+# Create the linked list from the input arguments.
+
+my $ll_input = make_link;
+my $ll_curpt = $ll_input;
+
+$ll_curpt = ( $ll_curpt->[1] = make_link $_ ) for @ARGV;
+$ll_input = pop @$ll_input;
+
+# Split the input linked list into "<" and ">=" linked lists.
+# This is a destructive rearrangement of the $ll_input linked list.
+
+my ( $lt_subll, $ge_subll ) = ( make_link, make_link );
+my ( $lt_curpt, $ge_curpt ) = ( $lt_subll, $ge_subll );
+
+while (@$ll_input) {
+    my $curr_ptr = $ll_input->[0] < $k ? \$lt_curpt : \$ge_curpt;
+    $ll_input = ( $$curr_ptr = ( $$curr_ptr->[1] = $ll_input ) )->[1];
+}
+
+( $lt_curpt->[1], $ge_curpt->[1] ) = ( NULL, NULL );
+( $lt_subll, $ge_subll ) = ( pop @$lt_subll, pop @$ge_subll );
+
+# Attach the ">=" linked list to the "<" list if "<" exists.
+
+$lt_curpt->[1] = $ge_subll if defined $lt_subll->[0];
+
+# Create output re-linked list.
+
+my $ll_ltge = defined $lt_subll->[0] ? $lt_subll : $ge_subll;
+
+# Print linked list data from head to tail.
+# This is a non-destructive walk of the $ll_ltge linked list.
+
+my ( $ll_print, $delim, @outlist ) = ( $ll_ltge, ' -> ', );
+
+( $outlist[@outlist], $ll_print ) = @$ll_print while @$ll_print;
+
+say join( $delim, @outlist );
diff --git a/challenge-059/jaredor/perl/ch-2.pl b/challenge-059/jaredor/perl/ch-2.pl
new file mode 100755
index 0000000000..873484518a
--- /dev/null
+++ b/challenge-059/jaredor/perl/ch-2.pl
@@ -0,0 +1,38 @@
+#!/usr/bin/env perl
+
+use v5.012;
+use warnings;
+use bigint;
+use Config;
+use List::Util qw(all sum);
+
+# PWC 059, TASK #2 : Bit Sum
+
+# Answer based on perl doc for unpack and www.perlmonks.org/?node_id=407933
+
+die "This script requires one or more positive integer arguments."
+  unless @ARGV;
+
+die "Not all arguments to the script are positive integers."
+  unless all { /\A [1-9] \d* \Z/xms } @ARGV;
+
+my ( $LL, $NN ) =
+  defined $Config{longlongsize}
+  ? ( 8 * $Config{longlongsize}, 'Q' )
+  : ( 8 * $Config{longsize}, 'L' );
+
+my $WORD = 2**$LL;
+
+sub num2bitstr {
+    my ( $numstr, $bitstr ) = ( $_[0], );
+    $bitstr .= pack "${NN}", $numstr % $WORD and $numstr /= $WORD while $numstr;
+    return $bitstr;
+}
+
+my @nums = map { num2bitstr $_ } @ARGV;
+
+my ( @diffbits, $num );
+while ( $num = pop @nums ) {
+    push @diffbits, unpack( "%${LL}b*", $num ^ $_ ) for @nums;
+}
+say @diffbits ? sum @diffbits : 0;