diff options
| author | Mohammad S Anwar <Mohammad.Anwar@yahoo.com> | 2020-04-14 02:10:54 +0100 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2020-04-14 02:10:54 +0100 |
| commit | bb36be4c4bde5250027efbb2075ef46bfc747b64 (patch) | |
| tree | e1b10658881be79005b61e205369d689a1f3e8d5 | |
| parent | 0709476470a9b914ac59877d42ef51dbe5ca6a9f (diff) | |
| parent | 607f0bdc06afd0cc6dc8c98e92879e22a09bc787 (diff) | |
| download | perlweeklychallenge-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.txt | 1 | ||||
| -rw-r--r-- | challenge-056/dave-jacoby/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-056/dave-jacoby/perl/ch-1.pl | 29 | ||||
| -rwxr-xr-x | challenge-056/dave-jacoby/perl/ch-2.pl | 75 |
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}; +} |
