aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMohammad S Anwar <Mohammad.Anwar@yahoo.com>2020-04-14 02:10:54 +0100
committerGitHub <noreply@github.com>2020-04-14 02:10:54 +0100
commitbb36be4c4bde5250027efbb2075ef46bfc747b64 (patch)
treee1b10658881be79005b61e205369d689a1f3e8d5
parent0709476470a9b914ac59877d42ef51dbe5ca6a9f (diff)
parent607f0bdc06afd0cc6dc8c98e92879e22a09bc787 (diff)
downloadperlweeklychallenge-club-bb36be4c4bde5250027efbb2075ef46bfc747b64.tar.gz
perlweeklychallenge-club-bb36be4c4bde5250027efbb2075ef46bfc747b64.tar.bz2
perlweeklychallenge-club-bb36be4c4bde5250027efbb2075ef46bfc747b64.zip
Merge pull request #1572 from jacoby/master
Challenge 56
-rw-r--r--challenge-055/dave-jacoby/blog.txt1
-rw-r--r--challenge-056/dave-jacoby/blog.txt1
-rwxr-xr-xchallenge-056/dave-jacoby/perl/ch-1.pl29
-rwxr-xr-xchallenge-056/dave-jacoby/perl/ch-2.pl75
4 files changed, 106 insertions, 0 deletions
diff --git a/challenge-055/dave-jacoby/blog.txt b/challenge-055/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..1e40edf3b8
--- /dev/null
+++ b/challenge-055/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2020/04/06/challenge-55-flipping-and-waving.html
diff --git a/challenge-056/dave-jacoby/blog.txt b/challenge-056/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..3f8c5a460a
--- /dev/null
+++ b/challenge-056/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2020/04/13/challenge-56-diffk-and-binary-trees.html \ No newline at end of file
diff --git a/challenge-056/dave-jacoby/perl/ch-1.pl b/challenge-056/dave-jacoby/perl/ch-1.pl
new file mode 100755
index 0000000000..9b0e356d9c
--- /dev/null
+++ b/challenge-056/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,29 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use utf8;
+use feature qw{ fc postderef say signatures state switch };
+no warnings qw{ experimental };
+
+diffk( 2, 2, 7, 9 );
+
+# You are given an array @N of positive integers (sorted)
+# and another non negative integer k.
+#
+# Write a script to find if there exists 2 indices i and j
+# such that A[i] - A[j] = k and i != j.
+#
+# It should print the pairs of indices, if any such pairs exist.
+
+## k is positive, N is sorted, so i will have to be higher than j
+sub diffk ( $k, @N ) {
+ for my $j ( 0 .. -1 + scalar @N ) {
+ for my $i ( $j + 1 .. -1 + scalar @N ) {
+ next if $i == $j;
+ next unless $k == $N[$i] - $N[$j];
+ say join ", ", $i, $j;
+ }
+ }
+
+}
diff --git a/challenge-056/dave-jacoby/perl/ch-2.pl b/challenge-056/dave-jacoby/perl/ch-2.pl
new file mode 100755
index 0000000000..11342ee7f9
--- /dev/null
+++ b/challenge-056/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,75 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use utf8;
+use feature qw{ postderef say signatures state switch };
+no warnings qw{ experimental };
+
+# make the tree
+my $hash->%* = map { $_ => new Node($_) } 1 .. 13;
+$hash->{5}->add_child( $hash->{4} );
+$hash->{5}->add_child( $hash->{8} );
+$hash->{4}->add_child( $hash->{11} );
+$hash->{11}->add_child( $hash->{7} );
+$hash->{11}->add_child( $hash->{2} );
+$hash->{8}->add_child( $hash->{13} );
+$hash->{8}->add_child( $hash->{9} );
+$hash->{9}->add_child( $hash->{1} );
+
+spider_tree( $hash->{5}, 22 );
+
+sub spider_tree ( $node, $value ) {
+ if ( $node->is_leaf() ) {
+ my $x = $node;
+ my $t = $x->value();
+ my @p = ( $x->value() );
+ while ( !$x->is_root ) {
+ $x = $x->parent();
+ $t += $x->value();
+ unshift @p, $x->value();
+ }
+ if ( $t == $value ) {
+ say $t;
+ say join ' -> ', @p;
+ }
+ }
+ for my $child ( $node->children() ) {
+ spider_tree( $child, $value );
+ }
+}
+
+package Node;
+
+sub new ( $class, $value = 0 ) {
+ my $self = {};
+ $self->{value} = $value;
+ $self->{children} = [];
+ $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 scalar $self->{children}->@* ? 0 : 1;
+}
+
+sub add_child ( $self, $node ) {
+ $node->{parent} = $self;
+ push $self->{children}->@*, $node;
+}
+
+sub children( $self ) {
+ return $self->{children}->@*;
+}
+
+sub parent ($self ) {
+ return $self->{parent};
+}