Merge pull request #1655 from jaredor/pwc058

Pwc058, jaredor submission

2 files changed, 171 insertions, 0 deletions

diff --git a/challenge-058/jaredor/perl/ch-1.pl b/challenge-058/jaredor/perl/ch-1.pl
new file mode 100755
index 0000000000..b2c437d45b
--- /dev/null
+++ b/challenge-058/jaredor/perl/ch-1.pl
@@ -0,0 +1,72 @@
+#!/usr/bin/env perl
+
+use v5.012;    # Using keys on arrays
+use warnings;
+use Data::Dump qw(pp);
+use List::Util qw(max min uniq);
+
+# PWC 058, Task #1 : Compare Version
+
+sub vercmp {
+
+    die "Exactly two arguments are required." unless @_ == 2;
+
+    for my $vstr (@_) {
+        die "Disallowed character, $1, in version string: $vstr"
+          if $vstr =~ /([^0-9._])/xms;
+        die "Missing version in version string: $vstr"
+          if $vstr =~ /\A [._] /xms;
+        die "Missing subversion in version string: $vstr"
+          if $vstr =~ / [._](?:[._]|\Z) /xms;
+    }
+
+    my $v1 = $_[0];
+    $v1 =~ s/\./.1./g;
+    $v1 =~ s/_/.0./g;
+    my @v1 = split( /\./, $v1 );
+
+    my $v2 = $_[1];
+    $v2 =~ s/\./.1./g;
+    $v2 =~ s/_/.0./g;
+    my @v2 = split( /\./, $v2 );
+
+    for my $i ( 0 .. max( $#v1, $#v2 ) ) {
+        my $lendiff = length( $v2[$i] ||= 0 ) - length( $v1[$i] ||= 0 );
+	my $zeros = '0' x abs $lendiff;
+        if    ( $lendiff > 0 ) { $v1[$i] = $zeros . $v1[$i]; }
+        elsif ( $lendiff < 0 ) { $v2[$i] = $zeros . $v2[$i]; }
+    }
+
+    return join( '', @v1 ) cmp join( '', @v2 );
+}
+
+# Input arguments will be, pairwise, the version numbers to compare.
+
+my @v1v2 = @ARGV;
+
+# If no input arguments, use problem statement example.
+
+@v1v2 = qw( 0.1    1.1
+  2.0    1.2
+  1.2    1.2_5
+  1.2.1  1.2_1
+  1.2.1  1.2.1 ) unless @v1v2;
+
+die "There needs to be an even number of version numbers." if @v1v2 % 2;
+
+my $v1len = max( 6, map { length $v1v2[$_] } grep { not $_ % 2 } keys @v1v2 );
+my $v2len = max( 6, map { length $v1v2[$_] } grep { $_ % 2 } keys @v1v2 );
+
+my $fmt = "%${v1len}s %1s %-${v2len}s %4s\n";
+
+print "\n";
+printf $fmt, 'v1', ' ', 'v2', 'Result';
+print '-' x ( $v1len + 1 ), ' ', '-' x ( $v2len + 1 ), ' ', '------', "\n";
+while (@v1v2) {
+    my $v1         = shift @v1v2;
+    my $v2         = shift @v1v2;
+    my $cmp        = vercmp $v1, $v2;
+    my $cmp_symbol = $cmp == 1 ? '>' : $cmp == -1 ? '<' : '=';
+    printf $fmt, $v1, $cmp_symbol, $v2, $cmp;
+}
+print "\n";
diff --git a/challenge-058/jaredor/perl/ch-2.pl b/challenge-058/jaredor/perl/ch-2.pl
new file mode 100755
index 0000000000..ecbc14f8c4
--- /dev/null
+++ b/challenge-058/jaredor/perl/ch-2.pl
@@ -0,0 +1,99 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Getopt::Long;
+use List::Util qw(all any);
+use List::MoreUtils qw(uniq indexes last_index);
+
+# PWC 058, TASK #2 : Ordered Lineup
+#
+# Write a script to arrange people in a lineup according to how many taller
+# people are in front of each person in line. You are given two arrays. @H is a
+# list of unique heights, in any order. @T is a list of how many taller people
+# are to be put in front of the corresponding person in @H. The output is the
+# final ordering of people’s heights, or an error if there is no solution.
+
+# @H = qw(2 6 4 5 1 3);
+# @T = qw(1 0 2 0 1 2);
+# @A = qw(5 1 2 6 3 4);
+
+sub procedural_ordered_lineup {
+    return sub {
+        my @HTP = sort { $b->[0] <=> $a->[0] } @_;
+        my @A = (undef) x ( 2 * @HTP );
+        while (@HTP) {
+            my ( $h, $t ) = @{ pop @HTP };
+            $A[ ( indexes { not defined $_ } @A )[$t] ] = $h;
+        }
+        return @A[ 0 .. last_index { defined $_ } @A ];
+      }
+}
+
+sub recursive_ordered_lineup {
+    return sub {
+        my @HTR = sort { $b->[0] <=> $a->[0] } @_;
+        sub slot_by_smallest {
+            my ( @bigger, @list ) = @_;
+            my ( $h,      $t )    = @{ pop @bigger };
+            @list = slot_by_smallest(@bigger) if @bigger;
+            $#list = $t if @list < $t;
+            splice @list, $t, 0, $h;
+            return @list;
+        }
+        return slot_by_smallest @HTR;
+      }
+}
+
+sub catch_undef {
+    my ( $OL, ) = @_;
+    return sub {
+        my @A = $OL->(@_);
+        @A = () unless all { defined $_ } @A;
+        return @A;
+      }
+}
+
+sub catch_impossible {
+    my ( $OL, ) = @_;
+    return sub {
+        my @A = ();
+        @A = $OL->(@_) unless any { $_->[1] < 0 or $_->[1] >= @_ } @_;
+        return @A;
+      }
+}
+
+sub report_result_of {
+    my $OL = catch_undef catch_impossible $_[0];
+    return sub {
+        if ( not @_ ) { warn "No information given for Ordered Lineup."; }
+        else {
+            my @A = $OL->(@_);
+            if (@A) { print join( ' ', @A ), "\n" if @A; }
+            else    { warn "The requested Ordered Lineup is not possible."; }
+        }
+      }
+}
+
+Getopt::Long::Configure( 'bundling_values', 'ignorecase_always',
+    'pass_through' );
+
+my ( $recursive, @H, @T, ) = ( '', );
+GetOptions(
+    'recursive!'   => \$recursive,
+    'height=i{1,}' => \@H,
+    'taller=i{1,}' => \@T,
+) or die "Problem with GetOptions.";
+
+die "The list of --height arguments need to be a list of unique elements"
+  unless @H == uniq @H;
+
+die "Number of --taller arguments must equal the number of --height arguments"
+  unless @T == @H;
+
+my @HT = map { [ $H[$_], $T[$_] ] } 0 .. $#H;
+
+my $ordered_lineup = $recursive ? recursive_ordered_lineup
+                                : procedural_ordered_lineup;
+
+(report_result_of $ordered_lineup)->(@HT);