Merge pull request #1672 from jacoby/master

Code for Challenge #59

3 files changed, 203 insertions, 0 deletions

diff --git a/challenge-059/dave-jacoby/perl/ch-1.1.pl b/challenge-059/dave-jacoby/perl/ch-1.1.pl
new file mode 100755
index 0000000000..73158774f8
--- /dev/null
+++ b/challenge-059/dave-jacoby/perl/ch-1.1.pl
@@ -0,0 +1,114 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use utf8;
+use feature qw{ postderef say signatures state switch };
+no warnings qw{ experimental };
+
+my $i;
+my $k = 3;
+my $head;
+my $above;
+my $below;
+
+# create a linked list!
+for my $i ( 1, 4, 3, 2, 5, 2 ) {
+    add_node( \$head, $i );
+}
+say 'BEFORE';
+display_list($head);
+say '';
+
+# undo first linked list, create before & after 
+while ( defined $head ) {
+    my $node = pop_head( \$head );
+    my $l    = $node->value;
+    if   ( $l < $k ) { add_node( \$below, $l ) }
+    else             { add_node( \$above, $l ) }
+}
+
+# combine below and above
+my $blast = get_last($below);
+$blast->next($above);
+
+say 'AFTER';
+display_list($below);
+say '';
+
+exit;
+
+sub pop_head ( $node ) {
+    my $h = $$node;
+    $$node = $$node->next;
+    return $h;
+}
+
+sub add_node ( $node, $i ) {
+    if ( defined $$node ) {
+        my $last = get_last($$node);
+        my $new  = Node->new($i);
+        $last->next($new);
+    }
+    else {
+        my $new = Node->new($i);
+        $$node = $new;
+    }
+}
+
+sub get_last( $node ) {
+    return get_last( $node->next ) if $node->next;
+    return $node;
+}
+
+sub display_list( $node ) {
+    return if !defined $node;
+    print $node->value if $node;
+    if ( $node->next ) {
+        print ' -> ';
+        display_list( $node->next );
+    }
+    else { say '' }
+}
+
+######### ######### ######### ######### ######### ######### #########
+# 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};
+}
diff --git a/challenge-059/dave-jacoby/perl/ch-1.pl b/challenge-059/dave-jacoby/perl/ch-1.pl
new file mode 100755
index 0000000000..0326409892
--- /dev/null
+++ b/challenge-059/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use utf8;
+use feature qw{ postderef say signatures state switch };
+no warnings qw{ experimental };
+
+my $k     = 3;
+my $input = [ 1, 4, 3, 2, 5, 2 ];
+
+say display_ll($input);
+my $output = task_1( $k, $input );
+say display_ll($output);
+
+# the "simple" version, not using actual linked lists
+# but not doing anything you can't regularly due with 
+# singly-linked lists, basically shift/remove-first
+# and push/add-last. Adding the first element of the 
+# second linked list to the end of the first linked 
+# list makes it a longer linked list.
+
+# I think I'll have to make my Node code into an actual
+# linked list eventually
+
+sub task_1 ( $k, $array ) {
+    my $output = [];
+    my @below ;
+    my @above ;
+    while ( $array->@* ) {
+        my $l = shift $array->@*;
+        if ( $l < $k ) {
+            push @below, $l;
+            next;
+        }
+        push @above, $l;
+    }
+    push $output->@*, @below, @above;
+    return $output;
+}
+
+sub display_ll($array) {
+    return join ' -> ', $array->@*;
+}
diff --git a/challenge-059/dave-jacoby/perl/ch-2.pl b/challenge-059/dave-jacoby/perl/ch-2.pl
new file mode 100755
index 0000000000..7642c3e7ee
--- /dev/null
+++ b/challenge-059/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,45 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use utf8;
+use feature qw{ postderef say signatures state switch };
+no warnings qw{ experimental };
+
+use List::Util qw{ sum };
+use Algorithm::Combinatorics 'combinations';
+
+use JSON;
+my $json = JSON->new->canonical->allow_nonref;
+
+say f2();
+say f2(1);
+say f2( 1, 3 );
+say f2( 2, 3, 4 );
+say f2( 2, 3, 4, 5 );
+say f2( 99,101 );
+
+# if array has < 2 entries, return 0 because there's not enough
+# to work with.
+# use combinations to get all possible combinations of n vals
+#   - for example, w/ 1,2,3: [1,2],[1,3],[2,3]
+sub f2 ( @array ) {
+    return 0 if scalar @array < 2;
+    my $sum = 0;
+    for my $combo ( combinations( \@array, 2 ) ) {
+        my $f = f( $combo->@* );
+        $sum += $f;
+    }
+    return $sum;
+}
+
+# back to front:
+#   $i ^ $j - XOR, which is $i or $j but not $i and $j
+#   sprintf - make a string representation of a
+#               binary number of the result
+#   split // - turn '00001111' into [0,0,0,0,1,1,1,1]
+#   sum     - add all the numbers in the array together
+sub f ( $i, $j ) {
+    return sum split //, sprintf '%b', $i ^ $j;
+}
+