From 3e3eaab4425f80435cdae0b67dea91f43a3dafb4 Mon Sep 17 00:00:00 2001
From: Dave Jacoby <jacoby.david@gmail.com>
Date: Mon, 20 Apr 2020 18:43:21 -0400
Subject: Challenge 57, and data files to go with

---
 challenge-057/dave-jacoby/perl/ch-1.pl    | 188 ++++++++++++++++++++++++++++++
 challenge-057/dave-jacoby/perl/ch-2.pl    |  39 +++++++
 challenge-057/dave-jacoby/perl/tree0.json |   9 ++
 challenge-057/dave-jacoby/perl/tree1.json |  13 +++
 challenge-057/dave-jacoby/perl/tree2.json |  14 +++
 challenge-057/dave-jacoby/perl/tree3.json |  21 ++++
 challenge-057/dave-jacoby/perl/treex.json |  22 ++++
 7 files changed, 306 insertions(+)
 create mode 100755 challenge-057/dave-jacoby/perl/ch-1.pl
 create mode 100755 challenge-057/dave-jacoby/perl/ch-2.pl
 create mode 100755 challenge-057/dave-jacoby/perl/tree0.json
 create mode 100755 challenge-057/dave-jacoby/perl/tree1.json
 create mode 100755 challenge-057/dave-jacoby/perl/tree2.json
 create mode 100755 challenge-057/dave-jacoby/perl/tree3.json
 create mode 100755 challenge-057/dave-jacoby/perl/treex.json

(limited to 'challenge-057')

diff --git a/challenge-057/dave-jacoby/perl/ch-1.pl b/challenge-057/dave-jacoby/perl/ch-1.pl
new file mode 100755
index 0000000000..6f3dec0bfc
--- /dev/null
+++ b/challenge-057/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,188 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use utf8;
+use feature qw{ fc postderef say signatures state switch };
+no warnings qw{ experimental };
+
+use List::Util qw{max};
+use JSON;
+
+my $json  = JSON->new->pretty->canonical;
+my %nodes = import_tree( $ARGV[0] );
+
+my ($rand) = keys %nodes;
+my $root = find_root( $nodes{$rand} );
+
+if ( is_binary_tree($root) ) {
+    display_tree($root);
+    reverse_tree($root);
+    display_tree($root);
+    export_tree( \%nodes, $ARGV[1] );
+}
+
+exit;
+
+sub tree_depth ( $node ) {
+    return 0 if $node->is_root();
+    return 1 + tree_depth( $node->parent() );
+}
+
+sub is_binary_tree ( $node ) {
+    state $depth = -1;
+
+    # if all the leaves are at the same depth
+    # return 1, else return 0
+    if ( $node->is_leaf ) {
+        my $d = tree_depth($node);
+        $depth = $d if $depth < 0;
+        return 0 if $depth != $d;
+        return 1;
+    }
+
+    # return 0 if we don't have two children
+    return 0 unless defined $node->left && defined $node->right;
+    return ( is_binary_tree( $node->left ) && is_binary_tree( $node->right ) );
+}
+
+sub display_tree ( $node, $depth = 0, $arrayref = [] ) {
+
+    # instead of hash or Node display, we're pulling it
+    # to $arrayref->[ depth ][ left .. right ]
+    if ($node) {
+        push $arrayref->[$depth]->@*, $node->value();
+        display_tree( $node->left(),  $depth + 1, $arrayref );
+        display_tree( $node->right(), $depth + 1, $arrayref );
+    }
+    else {
+        push $arrayref->[$depth]->@*, '_';
+    }
+
+    # when we've recursed and returned to the root
+    if ( $depth == 0 ) {
+        my $max   = $arrayref->@*;
+        my $w     = 4 + ( 2**$max );
+        my $edges = q{/  \\};
+        for my $i ( 0 .. -1 + scalar $arrayref->@* ) {
+            my $l = $arrayref->[$i];
+            next unless scalar grep { $_ ne '_' } $l->@*;
+            if ( $i > 0 ) {
+                my $l    = $arrayref->[ $i - 1 ];
+                my $str2 = join '    ', map { $edges } $l->@*;
+                my $pad2 = ' ' x ( $w - int( 0.5 * length $str2 ) );
+                say qq{$pad2$str2};
+            }
+            my $str = join '    ', $l->@*;
+            my $pad = ' ' x ( $w - int( 0.5 * length $str ) );
+            say qq{$pad$str};
+        }
+    }
+}
+
+sub reverse_tree( $node ) {
+    if ( defined $node->left() && defined $node->right() ) {
+        my $store = $node->left();
+        $node->left( $node->right() );
+        $node->right($store);
+    }
+    elsif ( defined $node->left() ) {
+        $node->right( $node->left() );
+        $node->{left} = undef;
+    }
+    elsif ( defined $node->right() ) {
+        $node->left( $node->right() );
+        $node->{right} = undef;
+    }
+    reverse_tree( $node->left() )  if $node->left();
+    reverse_tree( $node->right() ) if $node->right();
+}
+
+sub find_root( $node ) {
+    return $node if ( $node->is_root );
+    return find_root( $node->parent() );
+}
+
+sub import_tree ( $file = "" ) {
+    if ( -f $file && open my $fh, '<', $file ) {
+        my $text  = join '', <$fh>;
+        my $obj   = $json->decode($text);
+        my %nodes = map { $_ => Node->new($_) } $obj->{nodes}->@*;
+        for my $id ( $obj->{nodes}->@* ) {
+            my $left  = $obj->{left}{$id};
+            my $right = $obj->{right}{$id};
+            $nodes{$id}->left( $nodes{$left} )   if defined $left;
+            $nodes{$id}->right( $nodes{$right} ) if defined $right;
+        }
+        return wantarray ? %nodes : \%nodes;
+    }
+    exit;
+}
+
+sub export_tree ( $nodes, $file = undef ) {
+    my $obj = {};
+    for my $node ( values $nodes->%* ) {
+        my $left  = $node->left();
+        my $right = $node->right();
+        my $id    = $node->value();
+        push $obj->{nodes}->@*, $id;
+        $obj->{left}{$id}  = $left->value()  if $left;
+        $obj->{right}{$id} = $right->value() if $right;
+    }
+    $obj->{nodes}->@* = sort $obj->{nodes}->@*;
+    if ( defined $file && open my $fh, '>', $file ) {
+        say $fh $json->encode($obj);
+    }
+    else {
+        say $json->encode($obj);
+    }
+}
+
+package Node;
+
+sub new ( $class, $value = 0 ) {
+    my $self = {};
+    $self->{value}  = $value;
+    $self->{left}   = undef;
+    $self->{right}  = 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 left ( $self, $node = undef ) {
+    if ( defined $node ) {
+        $self->{left}   = $node;
+        $node->{parent} = $self;
+    }
+    else {
+        return $self->{left};
+    }
+}
+
+sub right ( $self, $node = undef ) {
+    if ( defined $node ) {
+        $self->{right}  = $node;
+        $node->{parent} = $self;
+    }
+    else {
+        return $self->{right};
+    }
+}
+
+sub parent ($self ) {
+    return $self->{parent};
+}
diff --git a/challenge-057/dave-jacoby/perl/ch-2.pl b/challenge-057/dave-jacoby/perl/ch-2.pl
new file mode 100755
index 0000000000..7a82d9335d
--- /dev/null
+++ b/challenge-057/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,39 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use utf8;
+use feature qw{ postderef say signatures state switch };
+no warnings qw{ experimental };
+
+use JSON;
+my $json = JSON->new->space_after;
+
+my @input = @ARGV;
+@input = ( "alphabet", "book", "carpet", "cadmium", "cadeau", "alpine" )
+  if !scalar @ARGV;
+
+my @output = sup(@input);
+
+say $json->encode( \@input );
+say $json->encode( \@output );
+
+sub sup( @words ) {
+    for my $word (@words) {
+        my $c = 1;
+      INNER: while (1) {
+            my $sub = substr( $word, 0, $c );
+            my $n   = scalar grep { m{^$sub} } @words;
+            if ( $n == 1 ) {
+                push @output, $sub;
+                last INNER;
+            }
+            if ( $sub eq $word ) {
+                push @output, $word;
+                last INNER;
+            }
+            $c++;
+        }
+    }
+    return @output;
+}
diff --git a/challenge-057/dave-jacoby/perl/tree0.json b/challenge-057/dave-jacoby/perl/tree0.json
new file mode 100755
index 0000000000..932b0e9e42
--- /dev/null
+++ b/challenge-057/dave-jacoby/perl/tree0.json
@@ -0,0 +1,9 @@
+{
+  "left": {
+    "1": 2
+  },
+  "nodes": [1, 2, 3 ],
+  "right": {
+    "1": 3
+  }
+}
diff --git a/challenge-057/dave-jacoby/perl/tree1.json b/challenge-057/dave-jacoby/perl/tree1.json
new file mode 100755
index 0000000000..87f7d7acb7
--- /dev/null
+++ b/challenge-057/dave-jacoby/perl/tree1.json
@@ -0,0 +1,13 @@
+{
+  "left": {
+    "1": 2,
+    "2": 4,
+    "3": 6
+  },
+  "nodes": [1, 2, 3, 4, 5, 6, 7],
+  "right": {
+    "1": 3,
+    "2": 5,
+    "3": 7
+  }
+}
diff --git a/challenge-057/dave-jacoby/perl/tree2.json b/challenge-057/dave-jacoby/perl/tree2.json
new file mode 100755
index 0000000000..b09daf4906
--- /dev/null
+++ b/challenge-057/dave-jacoby/perl/tree2.json
@@ -0,0 +1,14 @@
+{
+  "right": {
+    "1": 2,
+    "2": 4,
+    "3": 6
+  },
+  "nodes": [1, 2, 3, 4, 5, 6, 7, 8],
+  "left": {
+    "1": 3,
+    "2": 5,
+    "3": 7,
+    "7": 8
+  }
+}
diff --git a/challenge-057/dave-jacoby/perl/tree3.json b/challenge-057/dave-jacoby/perl/tree3.json
new file mode 100755
index 0000000000..d5daae5e2b
--- /dev/null
+++ b/challenge-057/dave-jacoby/perl/tree3.json
@@ -0,0 +1,21 @@
+{
+  "left": {
+    "1": 2,
+    "2": 4,
+    "3": 6,
+    "4": 8,
+    "5": 10,
+    "6": 12,
+    "7": 14
+  },
+  "nodes": [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15],
+  "right": {
+    "1": 3,
+    "2": 5,
+    "3": 7,
+    "4": 9,
+    "5": 11,
+    "6": 13,
+    "7": 15
+  }
+}
diff --git a/challenge-057/dave-jacoby/perl/treex.json b/challenge-057/dave-jacoby/perl/treex.json
new file mode 100755
index 0000000000..101324a246
--- /dev/null
+++ b/challenge-057/dave-jacoby/perl/treex.json
@@ -0,0 +1,22 @@
+{
+   "left" : {
+      "1" : 3,
+      "2" : 5,
+      "3" : 7
+   },
+   "nodes" : [
+      "1",
+      "2",
+      "3",
+      "4",
+      "5",
+      "6",
+      "7"
+   ],
+   "right" : {
+      "1" : 2,
+      "2" : 4,
+      "3" : 6
+   }
+}
+
-- 
cgit