Merge pull request #1992 from jacoby/master

Challenge 71

2 files changed, 210 insertions, 0 deletions

diff --git a/challenge-071/dave-jacoby/perl/ch-1.pl b/challenge-071/dave-jacoby/perl/ch-1.pl
new file mode 100755
index 0000000000..2a32e2a84c
--- /dev/null
+++ b/challenge-071/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,79 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say signatures state };
+no warnings qw{ experimental };
+
+use Carp;
+use Getopt::Long;
+use JSON;
+
+my $json = JSON->new->space_after;
+
+# a few interesting things before the solving actual
+# things
+
+# you are given a number $n where $n > 1
+my @array;
+my $n = 1;
+GetOptions( 'number=i' => \$n, );
+
+# we CANNOT have an array of unique elements, random or no,
+# if the desired size is greater than the pool of numbers.
+croak 'N needs to be greater than 1' if $n < 1;
+croak 'N needs to be less than 50'   if $n > 50;
+
+# write a script that creates an array of size $n
+# with random unique elements between 1 and 50
+while ( scalar @array < $n ) {
+    my $j = 1 + int rand 50;
+    push @array, $j unless grep { $j == $_ } @array;
+}
+
+# In the end it should print peak elements in the array, if found.
+my @peaks = peak_elements(@array);
+
+# I combine print and say to get the output as written in the
+# example
+
+print 'Array: ';
+say $json->encode( \@array );
+print 'Peak:  ';
+say $json->encode( \@peaks );
+
+exit;
+
+# a peak element is one that is larger than it's neighbors.
+# in abstract, array[i] > array[i-1] && array[i] > array[i+1]
+# but this is entirely the base case. Exceptions include:
+#   * array size = 1, so it is a peak in and of itself
+#   * first element, which only compares against the next element
+#   * last element, which only compares against the previous element
+# example results are correct, but order is weird. MY solution 
+# adds peaks in order they are found.
+
+# for example:
+# Array: [35, 12, 48, 22, 6, 21, 46, 1, 23, 31]
+# Peak:  [35,     48,            46,        31]
+
+sub peak_elements ( @array ) {
+    return @array if scalar @array == 1;
+    my @output;
+
+    for my $i ( 0 .. $#array ) {
+        if ( $i == 0 ) {
+            push @output, $array[$i] if $array[$i] > $array[ $i + 1 ];
+        }
+        elsif ( $i == $#array ) {
+            push @output, $array[$i] if $array[$i] > $array[ $i - 1 ];
+        }
+        else {
+            push @output, $array[$i]
+                if $array[$i] > $array[ $i - 1 ]
+                && $array[$i] > $array[ $i + 1 ];
+        }
+    }
+
+    return @output;
+}
diff --git a/challenge-071/dave-jacoby/perl/ch-2.pl b/challenge-071/dave-jacoby/perl/ch-2.pl
new file mode 100755
index 0000000000..00ffe0c25a
--- /dev/null
+++ b/challenge-071/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,131 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say signatures state };
+no warnings qw{ experimental };
+
+use Getopt::Long;
+my $n = 1;
+GetOptions( 'number=i' => \$n, );
+
+my $start;
+for my $i ( 1 .. 5 ) {
+    if ( !defined $start ) {
+        $start = Node->new($i);
+    }
+    else {
+        my $last = get_last($start);
+        $last->next( Node->new($i) );
+    }
+}
+
+trim_list( $start, $n );
+
+sub trim_list ( $link, $n = 1 ) {
+
+    # how big is the linked list?
+    my $i = 0;
+    my $s = $link;
+
+    while ( defined $s ) {
+        $i++;
+        $s = $s->{next};
+    }
+
+    my $stop = $i - $n + 1;
+    $stop = $stop < 1 ? 1 : $stop;
+
+    $i = 1;
+    $s = $link;
+    while ( defined $s ) {
+
+        $s->remove if $i == $stop;
+        $s = $s->{next};
+        $i++;
+    }
+
+    show_list($start);
+}
+
+sub show_list( $link ) {
+    while ( defined $link ) {
+        print $link->{value} || '';
+        if ( defined $link->{next} ) {
+            print ' -> '
+                if defined $link->{next};
+        }
+        else { print "\n" if !defined $link->{next}; }
+        $link = $link->{next};
+    }
+}
+
+sub get_last( $node ) {
+    return get_last( $node->next ) if $node->next;
+    return $node;
+}
+
+# copied and pasted from my Challenge #59 code
+
+######### ######### ######### ######### ######### ######### #########
+# The same old Node code, but instead of left and right,
+# it just has next
+
+package Node;
+
+sub new ( $class, $value = 0 ) {
+    my $self = {};
+    $self->{value}  = $value;
+    $self->{next}   = undef;
+    $self->{parent} = undef;
+    return bless $self, $class;
+}
+
+sub value ( $self ) {
+    return $self->{value};
+}
+
+sub is_root ( $self ) {
+    return defined $self->{parent} ? 0 : 1;
+}
+
+sub is_leaf ( $self ) {
+    return ( !defined $self->{left} && !defined $self->{right} )
+        ? 1
+        : 0;
+}
+
+sub next ( $self, $node = undef ) {
+    if ( defined $node ) {
+        $self->{next}   = $node;
+        $node->{parent} = $self;
+    }
+    else {
+        return $self->{next};
+    }
+}
+
+sub parent ($self ) {
+    return $self->{parent};
+}
+
+# this one is added.
+# because we cannot replace self, we must redefine
+# $self and remove next when trying to remove first 
+# element
+sub remove ( $self ) {
+    my $parent = $self->{parent};
+    my $next   = $self->{next};
+
+    if ( defined $parent && defined $next ) {
+        $parent->{next} = $next;
+        $next->{parent} = $parent;
+    }
+    elsif ( defined $parent ) {
+        $parent->{next} = undef;
+    }
+    elsif ( defined $next ) {
+        $self->{value} = $next->{value};
+        $next->remove;
+    }
+}