From acf7efe3c26276e986c039273f2df7179de5ab24 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Tue, 18 May 2021 15:18:23 +0100 Subject: true Binary tree version of the code... write a dump, clone & flatten function which uses walk rather than self coded - all take a fn which allows artibrary code to used when cloning the value and dump/flattening it --- challenge-113/james-smith/perl/BinaryTree.pm | 83 ++++++++++++++++++++++++++++ challenge-113/james-smith/perl/ch-2.pl | 68 ++++++++++++++++++++--- 2 files changed, 142 insertions(+), 9 deletions(-) create mode 100644 challenge-113/james-smith/perl/BinaryTree.pm diff --git a/challenge-113/james-smith/perl/BinaryTree.pm b/challenge-113/james-smith/perl/BinaryTree.pm new file mode 100644 index 0000000000..be0b5a88c8 --- /dev/null +++ b/challenge-113/james-smith/perl/BinaryTree.pm @@ -0,0 +1,83 @@ +package BinaryTree; + +use strict; +use warnings; +use Data::Dumper qw(Dumper); +use feature qw(say); + +## The tree is stored in an array ref +# The first element is the value of the node +# The remainder of the array are child sub-trees +# +# Methods: +# ->add_child( $child_tree ) +# ->flatten -- flatten list to array. +# + +sub new { + my $class = shift; + my $value = shift; + my $self = [ $value, undef, undef ]; + bless $self, $class; +} + +sub add_child_left { + my( $self,$child ) = @_; + $self->[1] = $child; + return $self; +} + +sub add_child_right { + my( $self,$child ) = @_; + $self->[2] = $child; + return $self; +} + +sub walk { + my( $self, $fn, $global, $local, $dir ) = @_; + my ($v,$l,$r) = @{$self}; + $local = $fn->( $self, $global, $local, $dir||'' ); + $l->walk( $fn, $global, $local, 'left' ) if defined $l; + $r->walk( $fn, $global, $local, 'right' ) if defined $r; + return; +} + +sub flatten { + my( $self,$dump_fn ) = @_; + $dump_fn ||= sub { $_[0] }; + my $arrayref = []; + $self->walk( sub { + my($node,$global) = @_; + push @{$global}, $dump_fn->( $node->[0] ); + }, $arrayref ); + return @{$arrayref}; +} + +sub dump { + my( $self, $dump_fn ) = @_; + $dump_fn ||= sub { $_[0] }; + $self->walk( sub { + my( $node, $global, $local, $dir ) = @_; + say join '', $local||'', $dir eq 'left' ? '<' : $dir eq 'right' ? '>' : ' ', ' ', $dump_fn->($node->[0]); + return $local .= ' '; + }, {}, '', '' ); + return; +} + +sub clone { + my( $self, $clone_fn ) = @_; + $clone_fn ||= sub { $_[0] }; + my $clone = {}; + $self->walk( sub { my( $node, $global, $local, $dir ) = @_; + if(exists $global->{'tree'} ) { + my $child = BinaryTree->new( $clone_fn->( $node->[0] ) ); + $dir eq 'left' ? $local->add_child_left( $child ) : $local->add_child_right( $child ); + return $child; + } + $global->{'tree'} = BinaryTree->new( $clone_fn->( $node->[0] ) ); + return $global->{'tree'}; + }, $clone ); + return $clone->{'tree'}; +} + +1; diff --git a/challenge-113/james-smith/perl/ch-2.pl b/challenge-113/james-smith/perl/ch-2.pl index a01ade26d2..47c2f4c84e 100644 --- a/challenge-113/james-smith/perl/ch-2.pl +++ b/challenge-113/james-smith/perl/ch-2.pl @@ -7,6 +7,7 @@ use feature qw(say); use Test::More; use lib '.'; use Tree; +use BinaryTree; my $x = Tree->new(1)->add_child( Tree->new(2)->add_child( @@ -16,33 +17,82 @@ my $x = Tree->new(1)->add_child( Tree->new(3)->add_child( Tree->new(5))->add_child( Tree->new(6) ) ); -my $data = { 't' => 0 }; ## Clone $x into $y -my $clone = { 'tree' => undef }; +my $clone = { 'total' => 0 }; +my $local; + +## Generate clone of $x, and compute the total of all the nodes... +## These will be stored as { 'tree' => OBJECT, 'total' => INT } +## in $global, $x->walk does a "pre-order" traversal of the tree. + $x->walk( sub { my( $node, $global, $local ) = @_; - if($global->{'tree'}) { + $global->{'total'} += $node->[0]; + if(exists $global->{'tree'}) { my $child = Tree->new( $node->[0] ); $local->add_child( $child ); return $child; } $global->{'tree'} = Tree->new( $node->[0] ); return $global->{'tree'}; -}, $clone ); +}, $clone ); + my $y = $clone->{'tree'}; say ''; say 'Dump $x'; -$x->walk( sub { my( $node, $global, $local ) = @_; say $local||='', '> ', $node->[0]; return $local.=' '; }, $data, ' ' ); +$x->walk( sub { my( $node, $global, $local ) = @_; say $local||='', '> ', $node->[0]; return $local.=' '; }, $y, ' ' ); +say ''; +say 'Dump $y (clone of $x)'; +$y->walk( sub { my( $node, $global, $local ) = @_; say $local||='', '> ', $node->[0]; return $local.=' '; }, $y, ' ' ); +say ''; +say 'Now get total value and adjust each node... for $y'; +$y->walk( sub { my( $node, $global ) = @_; $node->[0] = $global->{'total'} - $node->[0]; }, $clone ); +say ''; +say 'Dump $y (clone of $x)'; +$y->walk( sub { my( $node, $global, $local ) = @_; say $local||='', '> ', $node->[0]; return $local.=' '; }, $y, ' ' ); +say ''; + +say 'Running tests'; +is( "@{[ $x->flatten ]}", '1 2 4 7 3 5 6' ); +is( "@{[ $y->flatten ]}", '27 26 24 21 25 23 22' ); +say ''; + +$x = BinaryTree->new(1)->add_child_left( + BinaryTree->new(2)->add_child_left( + BinaryTree->new(4)->add_child_right( BinaryTree->new(7) ) + ) + )->add_child_right( + BinaryTree->new(3)->add_child_left( BinaryTree->new(5))->add_child_right( BinaryTree->new(6) ) + ); + + +## Generate clone of $x, and compute the total of all the nodes... +## These will be stored as { 'tree' => OBJECT, 'total' => INT } +## in $global, $x->walk does a "pre-order" traversal of the tree. + +## You will need to look more at BinaryTree.pm to see how all methods +## work - clone & dump are implemented using "walk" to walk the tree +## to save writing another tree walker! + +$y; + + +say ''; +say 'Dump $x'; +$x->dump( sub { "[$_[0]]"; } ); say ''; +say 'Clone $x as $y'; +$y = $x->clone; say 'Dump $y (clone of $x)'; -$y->walk( sub { my( $node, $global, $local ) = @_; say $local||='', '> ', $node->[0]; return $local.=' '; }, $data, ' ' ); +$y->dump( sub { "[$_[0]]"; } ); say ''; say 'Now get total value and adjust each node... for $y'; -$y->walk( sub { my( $node, $global ) = @_; $global->{'t'} += $node->[0]; }, $data ); -$y->walk( sub { my( $node, $global ) = @_; $node->[0] = $global->{'t'} - $node->[0]; }, $data ); +my $glob = { 'total' => 0 }; +$y->walk( sub { my( $node, $global ) = @_; $global->{'total'} += $node->[0]; }, $glob ); +$y->walk( sub { my( $node, $global ) = @_; $node->[0] = $global->{'total'} - $node->[0]; }, $glob ); say ''; say 'Dump $y (clone of $x)'; -$y->walk( sub { my( $node, $global, $local ) = @_; say $local||='', '> ', $node->[0]; return $local.=' '; }, $data, ' ' ); +$y->dump( sub { "[$_[0]]"; } ); say ''; say 'Running tests'; -- cgit From 679dc509ad21abb1f6d2365330639b3f40fc7c69 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Wed, 19 May 2021 11:59:29 +0100 Subject: just tidying --- challenge-113/james-smith/perl/ch-2.pl | 27 +++++++++++++++++++-------- 1 file changed, 19 insertions(+), 8 deletions(-) diff --git a/challenge-113/james-smith/perl/ch-2.pl b/challenge-113/james-smith/perl/ch-2.pl index 47c2f4c84e..53a05bf5d7 100644 --- a/challenge-113/james-smith/perl/ch-2.pl +++ b/challenge-113/james-smith/perl/ch-2.pl @@ -36,6 +36,8 @@ $x->walk( sub { my( $node, $global, $local ) = @_; $global->{'tree'} = Tree->new( $node->[0] ); return $global->{'tree'}; }, $clone ); +say; +say 'Original tree code'; my $y = $clone->{'tree'}; say ''; @@ -57,13 +59,18 @@ is( "@{[ $x->flatten ]}", '1 2 4 7 3 5 6' ); is( "@{[ $y->flatten ]}", '27 26 24 21 25 23 22' ); say ''; -$x = BinaryTree->new(1)->add_child_left( - BinaryTree->new(2)->add_child_left( - BinaryTree->new(4)->add_child_right( BinaryTree->new(7) ) - ) - )->add_child_right( - BinaryTree->new(3)->add_child_left( BinaryTree->new(5))->add_child_right( BinaryTree->new(6) ) - ); +$x = BinaryTree->new(1) + ->add_child_left( + BinaryTree->new(2) + ->add_child_left( + BinaryTree->new(4) + ->add_child_right( BinaryTree->new(7) ) + ) + )->add_child_right( + BinaryTree->new(3) + ->add_child_left( BinaryTree->new(5) ) + ->add_child_right( BinaryTree->new(6) ) + ); ## Generate clone of $x, and compute the total of all the nodes... @@ -76,8 +83,12 @@ $x = BinaryTree->new(1)->add_child_left( $y; +say ' +Now using the binary specific code - with clone/dump/flatten methods +added into the class implemented by walk + +'; -say ''; say 'Dump $x'; $x->dump( sub { "[$_[0]]"; } ); say ''; -- cgit From 434eda509d56beaebb3c0aa6c4aea3cc8d1f83c3 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Wed, 19 May 2021 11:59:53 +0100 Subject: speed up loop but also added unrolled version which is 50% faster --- challenge-113/james-smith/perl/ch-1.pl | 67 ++++++++++++++++++++++++++++++---- 1 file changed, 59 insertions(+), 8 deletions(-) diff --git a/challenge-113/james-smith/perl/ch-1.pl b/challenge-113/james-smith/perl/ch-1.pl index d8445c8f47..bdaa3409d9 100644 --- a/challenge-113/james-smith/perl/ch-1.pl +++ b/challenge-113/james-smith/perl/ch-1.pl @@ -5,31 +5,82 @@ use strict; use warnings; use feature qw(say); use Test::More; -use Benchmark qw(timethis); +use Benchmark qw(timethis cmpthese); my @ex = ( [25,8,0], [25,7,0], [24,7,1], [24,0,0], [10,0,1], [28,8,1], [26,8,1], [16,8,0], [441,9,1], [431,9,1] ); -is( represent( $_->[0], $_->[1]), $_->[2] ) foreach @ex; +is( represent( $_->[0], $_->[1]), $_->[2] ) foreach @ex; +is( represent_unrolled( $_->[0], $_->[1]), $_->[2] ) foreach @ex; + +## In this challenge we make the assumption that the numbers +## that need to be added are all different. This was not made +## clear in the question itself - but I think that this was +## implicit. done_testing(); + say ''; -timethis( 1_000_000, sub { represent($_->[0],$_->[1]) for @ex } ); +cmpthese( 1_000_000,{ + 'rolled' => sub { represent( $_->[0], $_->[1] ) for @ex }, + 'unrolled' => sub { represent_unrolled( $_->[0], $_->[1] ) for @ex }, +}); say ''; + sub represent { - my($t,$n,$d) = (0,@_); + + my( $t, $n, $d ) = ( 0, @_ ); + ## If $d is equal to 0 ## Any number between 100 & 109 can be represented by itself ## For numbers over 109 we can represent these as 100-109 + a ## number ending in 0... + ## e.g. 534 / 0 = 104 + 430 + ## + ## So if $d is equal to 0 then all numbers > 100 are possible + ## ## If $n is between 10*$d and 10*$d+9 then it can be represented as $d$x ## For numbers > than this we can do a similar trick to above - ## We can reprent them as $d$x + a number ending in $d - return 1 if $n >= 10 * ($d||10); + ## We can reprent them as a number ending in $d and a number + ## where $d is the penultimate digit + ## + ## e.g. 107 & 9 = **9** + **9**8 + ## e.g. 450 & 8 = 6**8** + 3**8**2 + ## e.g. 435 & 2 = 1**2** + 4**2**3 + ## + ## So if $d is not equal to 0 then all numbers greater than 10x$d + ## are possible + + return 1 if $n >= 10 * ( $d || 10 ); + ## Finally we get to the list of numbers less than this - as the only ## digit that can contain $d is the last one we just try to see if ## we can find a sum of numbers ending in $d which have the same last - ## digit as $n and less than or equal to $n. - $n>=($t+=$_*10+$d) && ($n%10 == $t%10) && return 1 for 0..9; + ## digit as $n and less than or equal to $n. Note as we have already + ## removed the numbers greater than 100 we now we only need to loop + ## up to 3 - as the next number would be 100 + 4$d.... + + ## Return 1 if both conditions hold true... + + $n >= ( $t += $_ * 10 + $d ) && + ( $n % 10 == $t % 10 ) && return 1 for 0..3; + + ## Return 0 if no solution is possible... + 0; } +sub represent_unrolled { + my( $n, $d ) = @_; + +## We can speed things up by a factor of 50% by unrolling the +## for loop and so we can reduce the test to the following - +## representing the check for the first type of solution and +## then the 4 checks within the loop... + + $n >= 10 * ( $d || 10 ) || + $n >= $d && $n%10 == $d || + $n >= 2*$d+10 && !( ($n-2*$d)%10 ) || + $n >= 3*$d+30 && !( ($n-3*$d)%10 ) || + $n >= 4*$d+60 && !( ($n-4*$d)%10 ) ? 1 : 0; +} + -- cgit From 7d19752068cca016bfa8417b3c22a2cece0ffa32 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Wed, 19 May 2021 12:59:31 +0100 Subject: added accessors + blog link --- challenge-113/james-smith/blog.txt | 1 + challenge-113/james-smith/perl/BinaryTree.pm | 44 +++++++++++++++++++++++----- challenge-113/james-smith/perl/ch-2.pl | 15 ++++++---- 3 files changed, 48 insertions(+), 12 deletions(-) create mode 100644 challenge-113/james-smith/blog.txt diff --git a/challenge-113/james-smith/blog.txt b/challenge-113/james-smith/blog.txt new file mode 100644 index 0000000000..0b9747f718 --- /dev/null +++ b/challenge-113/james-smith/blog.txt @@ -0,0 +1 @@ +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-113/james-smith diff --git a/challenge-113/james-smith/perl/BinaryTree.pm b/challenge-113/james-smith/perl/BinaryTree.pm index be0b5a88c8..e28307765a 100644 --- a/challenge-113/james-smith/perl/BinaryTree.pm +++ b/challenge-113/james-smith/perl/BinaryTree.pm @@ -21,6 +21,37 @@ sub new { bless $self, $class; } +sub value { + my $self = shift; + return $self->[0]; +} + +sub left { + my $self = shift; + return $self->[1]; +} + +sub right { + my $self = shift; + return $self->[2]; +} + +sub has_left { + my $self = shift; + return defined $self->[1]; +} + +sub has_right { + my $self = shift; + return defined $self->[2]; +} + +sub update { + my( $self, $val ) = @_; + $self->[0] = $val; + return $self; +} + sub add_child_left { my( $self,$child ) = @_; $self->[1] = $child; @@ -35,10 +66,9 @@ sub add_child_right { sub walk { my( $self, $fn, $global, $local, $dir ) = @_; - my ($v,$l,$r) = @{$self}; $local = $fn->( $self, $global, $local, $dir||'' ); - $l->walk( $fn, $global, $local, 'left' ) if defined $l; - $r->walk( $fn, $global, $local, 'right' ) if defined $r; + $self->left->walk( $fn, $global, $local, 'left' ) if $self->has_left; + $self->right->walk( $fn, $global, $local, 'right' ) if $self->has_right; return; } @@ -48,7 +78,7 @@ sub flatten { my $arrayref = []; $self->walk( sub { my($node,$global) = @_; - push @{$global}, $dump_fn->( $node->[0] ); + push @{$global}, $dump_fn->( $node->value ); }, $arrayref ); return @{$arrayref}; } @@ -58,7 +88,7 @@ sub dump { $dump_fn ||= sub { $_[0] }; $self->walk( sub { my( $node, $global, $local, $dir ) = @_; - say join '', $local||'', $dir eq 'left' ? '<' : $dir eq 'right' ? '>' : ' ', ' ', $dump_fn->($node->[0]); + say join '', $local||'', $dir eq 'left' ? '<' : $dir eq 'right' ? '>' : ' ', ' ', $dump_fn->($node->value); return $local .= ' '; }, {}, '', '' ); return; @@ -70,11 +100,11 @@ sub clone { my $clone = {}; $self->walk( sub { my( $node, $global, $local, $dir ) = @_; if(exists $global->{'tree'} ) { - my $child = BinaryTree->new( $clone_fn->( $node->[0] ) ); + my $child = BinaryTree->new( $clone_fn->( $node->value ) ); $dir eq 'left' ? $local->add_child_left( $child ) : $local->add_child_right( $child ); return $child; } - $global->{'tree'} = BinaryTree->new( $clone_fn->( $node->[0] ) ); + $global->{'tree'} = BinaryTree->new( $clone_fn->( $node->value ) ); return $global->{'tree'}; }, $clone ); return $clone->{'tree'}; diff --git a/challenge-113/james-smith/perl/ch-2.pl b/challenge-113/james-smith/perl/ch-2.pl index 53a05bf5d7..bb453db985 100644 --- a/challenge-113/james-smith/perl/ch-2.pl +++ b/challenge-113/james-smith/perl/ch-2.pl @@ -59,6 +59,11 @@ is( "@{[ $x->flatten ]}", '1 2 4 7 3 5 6' ); is( "@{[ $y->flatten ]}", '27 26 24 21 25 23 22' ); say ''; +## I've also implemented a true binary tree - the difference +## is that we explicitly have a left and right node. +## The "add_child" has been split into add_child_left & +## add_child_right. + $x = BinaryTree->new(1) ->add_child_left( BinaryTree->new(2) @@ -90,20 +95,20 @@ added into the class implemented by walk '; say 'Dump $x'; -$x->dump( sub { "[$_[0]]"; } ); +$x->dump; say ''; say 'Clone $x as $y'; $y = $x->clone; say 'Dump $y (clone of $x)'; -$y->dump( sub { "[$_[0]]"; } ); +$y->dump; say ''; say 'Now get total value and adjust each node... for $y'; my $glob = { 'total' => 0 }; -$y->walk( sub { my( $node, $global ) = @_; $global->{'total'} += $node->[0]; }, $glob ); -$y->walk( sub { my( $node, $global ) = @_; $node->[0] = $global->{'total'} - $node->[0]; }, $glob ); +$y->walk( sub { my( $node, $global ) = @_; $global->{'total'} += $node->value; }, $glob ); +$y->walk( sub { my( $node, $global ) = @_; $node->update( $global->{'total'} - $node->value ); }, $glob ); say ''; say 'Dump $y (clone of $x)'; -$y->dump( sub { "[$_[0]]"; } ); +$y->dump; say ''; say 'Running tests'; -- cgit From 6f23cbf99a76ecff5522b61e2a08e93a37923412 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Wed, 19 May 2021 13:00:06 +0100 Subject: Update README.md --- challenge-113/james-smith/README.md | 672 ++++++++++++------------------------ 1 file changed, 220 insertions(+), 452 deletions(-) diff --git a/challenge-113/james-smith/README.md b/challenge-113/james-smith/README.md index 35cdf3b77a..621fc13607 100644 --- a/challenge-113/james-smith/README.md +++ b/challenge-113/james-smith/README.md @@ -1,4 +1,4 @@ -# Perl Weekly Challenge #112 +# Perl Weekly Challenge #113 You can find more information about this weeks, and previous weeks challenges at: @@ -8,544 +8,312 @@ If you are not already doing the challenge - it is a good place to practise your **perl** or **raku**. If it is not **perl** or **raku** you develop in - you can submit solutions in whichever language you feel comfortable with. -# Challenge 1 - Canonical Path - -**You are given a string path, starting with a slash ‘/'. Write a script to -convert the given absolute path to the simplified canonical path.** - -In a Unix-style file system: - - * A period '.' refers to the current directory - * A double period '..' refers to the directory up a level - * Multiple consecutive slashes ('//') are treated as a single slash '/' - -The canonical path format: - - * The path starts with a single slash '/'. - * Any two directories are separated by a single slash '/'. - * The path does not end with a trailing '/'. - * The path only contains the directories on the path from the root directory to the target file or directory - -## Note.... - -Please note there is an ambiguity in the question - when then path contains no -files - as it cannot start with a '/' and not end with a '/' - so we have -to make a choice do we return '/' or do we return ''. - -In our case we decide to return it as the empty string. -This has the advantage that there is a level of consistency if you do... +You can find the solutions here on github at: -$parent_dir.canonical_path('/a'); +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-113/james-smith/perl -or - -$parent_dir.canonical_path('/'); +# Challenge 1 - Canonical Path -then it will always end without a "/"; +**TASK #1: Represent Integer -To change the value the functions return you can replace the return -statement with either `return q(/). join q(/), @list` or -`return $str || q(/)`, depending on whether or not the function -stores the path elements in an array or a string. +You are given a positive integer `$N` and a digit `$D`. Write a script to +check if $N can be represented as a sum of positive integers having `$D` at +least once. If check passes print `1` otherwise `0`.** -## Solution to challenge 1 +**Assumption** although not clear in the question, we make the +assumption that the numbers in the sum are all unique. -Again another interesting challenge ... we can see if we can improve -performance. +## Solution... -Initially it looks quite complex - there are two solutions classes: +There are two classes of solution to this problem: - * splitting the string and creating/modifying an array of the - individual parts + 1. Solutions where `$D` only appears in the right hand column. + 1. Solutions where `$D` appears in more than one column. - * splitting the string and creating/modifying a string +### Type 2 solutions... +If `$D` is 0. Then we can find solutions for all numbers `>=100`. For +the numbers `100` -> `109` the number itself surfices. For numbers +`>=110` we can always find a solution of the form (or similar): -## "Expanded perl code" +``` + x x x x 0 x ++ x 0 +``` -### Array - two loops... +If `$D` in not 0. Then we can find similar solutions for all numbers +`>= 10*$D`. Again for `10*$D` -> `10*$D + 9` the number itself surfices. +For numbers `>=11*$D` we have similar solutions to above where we can +write the nubmer as: - * We first split the directory into path parts and remove any that - are empty or "`.`". +``` + x x x x D x ++ x D +``` - * We loop through the array until we find a '`..`' if we do we - remove it and the previous entry. +So we check for that first, then we can look at the type (1) solutions - * We then repeat this until we don't find a '`..`' +### Type 1 solutions... - * To jump out of the loop we use `next "label"` to not just skip out - of the inner loop, but to also to restart the parent loop at the - same time. +We need a sequence of numbers `$D`, `10+$D`, `20+$D`, `30+$D` *etc* +that is less than or equal to `$N` and has the same last digit as `$N`. +Now we note `$D + 10+$D + 20+$D + 30+$D + 40+$D` is `100 + 5$D` and so +we know this is possible to represent for all values of `$D` so we +can ignore this case. - * Finally remove an initial "`..`" which wouldn't get removed by this - algorithm. +## Perl code - * and join the array together with '`/`' - we add the `''` so that we - get the leading '`/`'. +The first pass at this uses a for loop to generate the values of the +numbers in the sum. After first checking the criteria for type 2 +solutions... ```perl -sub canonical_path_double { - my $directory_path = shift; - my @directory_names = grep { $_ ne '' && - $_ ne '.' } - split m{/}, - $directory_path; - - OUTER: while(1) { - foreach (1..$#directory_names) { - next unless $directory_names[$_] eq '..'; - splice @directory_names,$_-1,2; - next OUTER; - } - last; - } - shift @directory_names if @directory_names && $directory_names[0] eq '..'; - return join '/','',@directory_names; +sub represent { + my( $t, $n, $d ) = ( 0, @_ ); + return 1 if $n >= 10 * ( $d || 10 ); + $n >= ( $t += $_ * 10 + $d ) && + ( $n % 10 == $t % 10 ) && return 1 for 0..3; + 0; } ``` -### Array - 1-loop - -We don't need to use a double loop - we can just treat -the resultant array as a queue either pulling "`..`" or -pushing (not "` `" or "`.`") onto the queue. +We can further improve performance by removing the need for the `$t` +variable and the `for` loop by "unrolling" the loop as below... ```perl -sub canonical_path_array { - my $directory_path = shift; - my @parts = split m{/}, $directory_path; - my @directory_names; - foreach my $part ( @parts ) { - next if $part eq ''; - next if $part eq '.'; - if($part eq '..' ) { - pop @directory_names; - } else { - push @directory_names, $part; - } - } - return join '/','',@directory_names; +sub represent_unrolled { + my( $n, $d ) = @_; + $n >= 10 * ( $d || 10 ) || + $n >= $d && $n%10 == $d || + $n >= 2*$d+10 && !( ($n-2*$d)%10 ) || + $n >= 3*$d+30 && !( ($n-3*$d)%10 ) || + $n >= 4*$d+60 && !( ($n-4*$d)%10 ) ? 1 : 0; } ``` -### String - 1-loop +This appears to be 50% faster than the loop solution... -Rather than store the parts in a list - we use a string to store -this canonical path - and we either add directories to the end of -it or remove them if we come across a "`..`", in a similar way to -the `push`/`pop` that we used above. +# Challenge 2 - Recreate Binary Tree - * We achieve the former - by just concatenating a "`/`" and the - name to the end of the string. +**You are given a Binary Tree. Write a script to replace each +node of the tree with the sum of all the remaining nodes.** - * The latter we strip this string off with a regex substitution: - `s{/[^/]+\Z}{}`. This works in all cases wherever the "`..`" - is in the list. +We already have an embryonic `Tree` object from the Linked list/tree +challenge in week 94. - * Note as we are looping through the array we can ignore the - grep and just skip out of the loop if the name is either "" - or "`.`". +So we will extend this (and to write a true `BinaryTree`) representation. -```perl -sub canonical_path_string { - my $path = shift; - my @directories = split m{/}, $path; - my $canonical_path = ''; - foreach my $directory_name ( @directories ) { - next if $directory_name eq ''; - next if $directory_name eq '.'; - if( $directory_name eq q(..) ) { - $canonical_path =~ s{/[^/]+\Z}{}; - } else { - $canonical_path .= q(/) . $directory_name; - } - } - return $canonical_path; -} -``` -### String fast - 1-loop +## Walk the tree -Regexs are not the fastest way to perform simple matches strings -(and intern to modify them). We can speed up the trimming of the -canonical path by replacing the regex solution by using `rindex` -and the four-parameter version of `substr`. +For each of the problems cloning, summing, updating a tree we need to +walk the tree. The solution I propose here will define a "walking" +function on the tree, which has it's parameters: - * `rindex $str, $needle` finds the index of `$needle` in `$str`. - Here we use it to find the last `/` in string. + * a function to handle each node + * a "global" storage object + * a "local" storage object + * whether the node is a left child / right child. - * `substr $str, $offset, $length, $substitute` finds the chunk of - the string `$str` from `$offset` of given length `$length`. If a - fourth parameter is set then this region of the string is replaced - by `$substitute`. +## Perl `BinaryTree` object. - * We can use this to truncate the string by doing: - - `substr $path, rindex( $path, '/' ), ~0, '';` +Our binary tree is represented by an array of length 3. The value of +the node {which can be any object} and the left and right children. - In the two-parameter version of `substr` if we omit length then - this returns to the end of the string. In the four-parameter - version - we can't omit this - so have to use an alternative - value - it has to be bigger than the longest string possible. - We use the "bitwise-negation" operator "`~`" to generate the - largest value possible. This is: 18,446,744,073,709,551,615 or - just shy of 16 Exabytes - I believe this should be big enough! +We then have two methods - `add_left_child` and `add_right_child` to +add them to the tree. - (Note you can use -ve numbers but there is no way of doing `-0` - to trim to the end of the line) +We also have accessors: -The script then becomes: + * `left` - left child + * `right` - right child + * `value` - value of node -```perl -sub canonical_path_string_fast { - my $path = shift; - my @directories = split m{/}, $path; - my $canonical_path = ''; - foreach my $directory_name ( @directories ) { - next if $directory_name eq ''; - next if $directory_name eq '.'; - if( $directory_name eq q(..) ) { - substr $canonical_path, - rindex( $canonical_path, '/' ), - ~0, ''; - } else { - $canonical_path .= q(/) . $directory_name; - } - } - return $canonical_path; -} -``` +We have to functions to check for existance of a child: -## "Compact perl code" AKA 1-liners.. + * `has_left` - left child + * `has_right` - right child -Now we can look at how we can compact this code. Here though we -need to consider the trade off between size and performance - the -smallest code is not necessarily the fastest - as some of the -tricks to make the code compact also make it slower. +and finally a method to update a node `update` -### The array code... +```perl +package BinaryTree; -We have two versions of the code - which are slightly different -The `canonical_path_compact_opt` function is probably closer to -the 1-loop array function above. We use nested-ternaries to replace -the `if else` blocks. +sub new { + my $class = shift; + my $value = shift; + my $self = [ $value, undef, undef ]; + bless $self, $class; +} -As well as using ternaries to make the code shorter - we use a few -other of our "shortening" tricks: +sub update { + my( $self, $val ) = @_; + $self->[0] = $val; + return $self; +} - * We use **yoda** comparisons ( `"value" eq $variable` ) rather tha - the more normal `$variable eq "value"` as it means we can save a - byte { `$var eq''` vs `''eq$var` } as we don't need the extra space. +sub value { + my $self = shift; + return $self->[0]; +} - * We re-order the if/else so that the we unravel it into an: - `if() { } elsif() {} else {}` format which is better for - nested ternaries - even if it may seenm to be less readable. +sub add_child_left { + my( $self,$child ) = @_; + $self->[1] = $child; + return $self; +} - * To futher shorten the code in `canonical_path_compact` we - replace the filtering clause with a regular expression which is - 7-bytes shorter. +sub add_child_right { + my( $self,$child ) = @_; + $self->[2] = $child; + return $self; +} -```perl +sub left { + my $self = shift; + return $self->[1]; +} -sub canonical_path_compact_opt { - my @d=(); - ''ne$_&&'.'ne$_&&('..'eq$_?pop@d:push@d,$_)for split/\//,shift; - join'/','',@d; +sub right { + my $self = shift; + return $self->[2]; } -my @g; -sub canonical_path_compact_glob { - @g=(); - ''ne$_&&'.'ne$_&&('..'eq$_?pop@g:push@g,$_)for split/\//,shift; - join'/','',@g; +sub has_left { + my $self = shift; + return defined $self->[1]; } -sub canonical_path_compact { - my @d=(); - /^\.?$/||('..'eq$_?pop@d:push@d,$_)for split/\//,shift; - return join'/','',@d; +sub has_right { + my $self = shift; + return defined $self->[2]; } + ``` -### The string code +## Walking the tree... -Here we re-implement the two string algorithms in compact 1-liners. +Our tree walking function takes up to 4 parameters: - * `canonical_path_fast` and `canonical_path_fastest` correspond - directly to the two methods above. + 1. `$fn` a callback function which does whatever is needed, + e.g. collect summary statistics, update the node etc; + 1. `$global` a reference to a variable which is used as + "global" storage for the walk + 1. `$local` a variable which is used as "local" storage for the walk, + it is updated as the value from `$fn` before being passed to the + children, + 1. `$dir` the direction of the walk whether it be "left" or "right" - * `canonical_path_short` replaces the equality checks for "" and - "`.`" with the regex as we saw in the array code. +`$self`, `$global`, `$local` and `$dir` are all passed to the callback +function.... + +The code itself is quite simple to look at... - * `canonical_path_shortest` removes the need for one of the - ternary operators by performing string multiplication when - adding the directory to the list. If the regex returns true, - then `"/$_"x!/.../` is `"/$_"x 0` or "". If the regex returns - false then `"/$_"x!/.../` is `"/$_"x 1` or "`/$_`". - -```perl -sub canonical_path_shortest { -$a=''; -'..'ne$_?$a.="/$_"x!/^\.?$/:$a=~s#/[^/]+$## for split'/',shift; -$a -} -``` -```perl -sub canonical_path_short { -$a=''; -/^\.?$/?0:'..'ne$_?$a.="/$_":$a=~s#/[^/]+$## for split'/',shift; -$a -} -``` -```perl -sub canonical_path_fast { -$a=''; -'.'ne$_&&''ne$_&&('..'ne$_?$a.="/$_":$a=~s#/[^/]+$##)for split'/',shift; -$a -} -``` -```perl -sub canonical_path_fastest { -$a=''; -'.'ne$_&&''ne$_&&('..'ne$_?$a.='/'.$_:substr$a,rindex($a,'/'),~0,'')for split'/',shift; -$a -} -``` ```perl -my $s; -sub canonical_path_global { -$s=''; -'.'ne$_&&''ne$_&&('..'ne$_?$s.='/'.$_:substr$s,rindex($s,'/'),~0,'')for split'/',shift; -$s +sub walk { + my( $self, $fn, $global, $local, $dir ) = @_; + my ($v,$l,$r) = @{$self}; + $local = $fn->( $self, $global, $local, $dir||'' ); + $self->left->walk( $fn, $global, $local, 'left' ) if defined $self->has_left; + $self->right->walk( $fn, $global, $local, 'right' ) if defined $self->has_right; + return; } ``` -## Performance of different methods - -We will look at some different versions of the code: - - * whether we use an array or string to accumulate the resultant path - * Whether we use "readable" code or Perl hacks and tricks - -To see what aspects of our code makes it faster or slower - -### Summary of methods.. - * "Long form" Perl... - * `canonical_path_double` - Using a double loop - * `canonical_path_array` - Using backtracking instead of inner loop - * `canonical_path_string` - Use a string as the accumulator and mapping - * `canonical_path_string_fast` - As above - but using substr/rindex - * "One-liner" perl {arrays} - * `canonical_path_compact` - short version of array code - * `canonical_path_compact_opt` - optimized version of above - 1-less regex - * `canonical_path_compact_glob` - as above but with global variable - * "One-liner" perl {strings} - * `canonical_path_shortest` - most compact method - * `canonical_path_short` - compact method - * `canonical_path_fast` - replace one of the regex with equality checks - * `canonical_path_fastest` - replace other regex with substr/rindex - * `canonical_path_global` - as fastest but with global variable... - -### Performance of each method: - -| | Rate | @-sh | $-st | $-sh | @&2l | $&fa | $-fa | @&ft | $&ft | @-ft | @-gl | $-ft | $-gl | -| ------------ | -------- | ---: | ---: | ---: | ---: | ---: | ---: | ---: | ---: | ---: | ---: | ---: | ---: | -| @-short | 20,877/s | -- | -6% | -8% | -15% | -25% | -32% | -38% | -43% | -45% | -45% | -50% | -51% | -| $-shortest | 22,124/s | 6% | -- | -2% | -10% | -21% | -28% | -34% | -40% | -41% | -42% | -47% | -48% | -| $-short | 22,573/s | 8% | 2% | -- | -8% | -19% | -27% | -33% | -39% | -40% | -41% | -46% | -47% | -| @-&-2-loop | 24,631/s | 18% | 11% | 9% | -- | -12% | -20% | -26% | -33% | -35% | -35% | -41% | -42% | -| $-&-fast | 27,933/s | 34% | 26% | 24% | 13% | -- | -9% | -16% | -24% | -26% | -27% | -34% | -35% | -| $-fast | 30,769/s | 47% | 39% | 36% | 25% | 10% | -- | -8% | -17% | -18% | -19% | -27% | -28% | -| @-&-fastest | 33,445/s | 60% | 51% | 48% | 36% | 20% | 9% | -- | -9% | -11% | -12% | -20% | -22% | -| $-&-fastest | 36,900/s | 77% | 67% | 63% | 50% | 32% | 20% | 10% | -- | -2% | -3% | -12% | -14% | -| @-fastest | 37,736/s | 81% | 71% | 67% | 53% | 35% | 23% | 13% | 2% | -- | -1% | -10% | -12% | -| @-global | 38,168/s | 83% | 73% | 69% | 55% | 37% | 24% | 14% | 3% | 1% | -- | -9% | -11% | -| $-fastest | 42,017/s | 101% | 90% | 86% | 71% | 50% | 37% | 26% | 14% | 11% | 10% | -- | -2% | -| $-global | 42,735/s | 105% | 93% | 89% | 74% | 53% | 39% | 28% | 16% | 13% | 12% | 2% | -- | - - -### Summary -What we see is: - * that the optimized string code is faster than the array code, - by around 12-15% - * using compact "1-liner" code can be approximately 10% - faster. - * but using less regex's and replacing them with - eq/ne for comparisons and `substr`/`rindex` for - replacement/trimming improves the speed the most. - * approx 25-30% for removing the comparison regex for checking - `' '` or `'.'` and replacing with two `eq`/`ne` - * approx 30-40% for removing the substitute of the string - from the last `'/'` to the end of the string, with `rindex` - and the the four parameter version of `substr`. - * combining the two seems to double the performance! - * switching from local to global variables gets a minor - gain (about 1-2%) again due to memory management. - -## Conclusion - -So short code is interesting - but is not by a long shot the -most efficient especially in respect of converting regexes into -`substr`/`index`/`rindex`, allocation of variables, even if we -keep it to a 1-liner. - -*e.g.* with the short code - we see the optimal short string code is -twice as efficient as the shortest version - and only about 33% longer. - -One of the interesting things is that there is some discussion that -avoiding concatenating strings by pushing them into an array and -joining them is supposedly faster than just concatenating.... This -seems to prove otherwise.. So don't assume everything you read - but -check it yourself! - -# Challenge 2 - Climb Stairs - -You are given `$n` steps to climb - Write a script to find out the -distinct ways to climb to the top. You are allowed to climb either -1 or 2 steps at a time. - -## Assumption - -Although not clear - I just assumed that the response was a single -numeric value. - -## Solution - -We first note that the formula for number of steps climbed can be -seen to be. - - `count_n = count_(n-1) + count_(n-2)` - -As the last step is either a 1-step (when there are therefore `count_(n-1)` -options to get to that step) or 2-step (when there are therefore `count_(n-2)` -options to get to that step)... - -This is a recognisable formula - it is just a fibonnaci sequence. - -## Brute force solution - -We could use a recursive method to get the fibonnaci values out - but -that would have function call overheads - rather we can use just two -variables to store the sequence, we define `$a` & `$b` to both be `1` -and then each iteration through we set `$a` to `$b` and `$b` to the sum -of `$a` & `$b`. We just then return the last value of `$b`. +## Cloning - with walk ```perl -sub climb { - my($a,$b) = (1,1); - ($a,$b) = ($b,$a+$b) foreach 2..$_[0]; - return $b; +sub clone { + my( $self, $clone_fn ) = @_; + $clone_fn ||= sub { $_[0] }; + my $clone = {}; + $self->walk( sub { my( $node, $global, $local, $dir ) = @_; + if(exists $global->{'tree'} ) { + my $child = BinaryTree->new( $clone_fn->( $node->value ) ); + $dir eq 'left' ? $local->add_child_left( $child ) : $local->add_child_right( $child ); + return $child; + } + $global->{'tree'} = BinaryTree->new( $clone_fn->( $node->value ) ); + return $global->{'tree'}; + }, $clone ); + return $clone->{'tree'}; } ``` +We can use this `walk` method to clone our tree. +Global is a hashref with one entry - 'tree' which will contain our +cloned tree. -This uses one of the nice features of perl in the fact that you can -assign to more than one variable with the same statement, you often -see this when you flip two values over. - -Classically you would write: +The first time through the loop it initialises the tree and adds the +root node to the tree and returns itself. `$local` is then this node. -```perl -my $t = $a; -$a = $b; -$b = $t; -``` -but you in perl can write this as: -```perl -($a,$b)=($b,$a); -``` -without the need of the additionaly (temporary) variable. +For subsequent calls the tree exists and so a new BinaryTree objects is +produced and attached to it's parent (which is held in `$local`) either +as a left or right child. -## Building a cache using state or global variables - or pre-computing +`clone` can take an additional `callback` which is applied to each +node when being copied - which defaults to just a straight copy. -If the call is being made repeatedly we can cache results - either -using a "`state`" variable within the function or a "`global`" variable. +There are two more "walk methods" in the object, which dump the data: +either as a single line of values (flatten) or as "ASCII-art" to show +the nodes and their relationships. ```perl -sub climb_cache { - state @cache = (1,1); - $cache[$_]=$cache[$_-1]+$cache[$_-2] foreach @cache .. $_[0]; - return $cache[$_[0]]; +sub flatten { + my( $self,$dump_fn ) = @_; + $dump_fn ||= sub { $_[0] }; + my $arrayref = []; + $self->walk( sub { + my($node,$global) = @_; + push @{$global}, $dump_fn->( $node->value ); + }, $arrayref ); + return @{$arrayref}; } -my @glob_cache = (1,1); -sub climb_cache_glob { - $glob_cache[$_]=$glob_cache[$_-1]+$glob_cache[$_-2] foreach @glob_cache .. $_[0]; - return $glob_cache[$_[0]]; +sub dump { + my( $self, $dump_fn ) = @_; + $dump_fn ||= sub { $_[0] }; + $self->walk( sub { + my( $node, $global, $local, $dir ) = @_; + say join '', + $local||'', + $dir eq 'left' ? '<' : $dir eq 'right' ? '>' : ' ', + ' ', $dump_fn->($node->value); + return $local .= ' '; + }, {}, '', '' ); + return; } ``` -Finally we look at the cache check overhead by pre-computing the values into -a cache and then run: +Like clone they take a simple call back if you want to include a +function of the object's values rather than the value itself.... +*a callback* within *a callback*.... You could even say its +***Turtles all the way down***... -```perl -sub climb_lookup { - return $ans[$_[0]]; -} -``` +## The solution -## Mathematical formula solution +### Walking the tree to get the sum -There is Binet's formula for the `n`th fibonacci number which is: +We create a "*global*` variable which contains the total, walk through +all nodes and add the node value to this total.... We can then +retrieve the value by inspecting `$glob`.. +```perl +my $glob = { 'total' => 0 }; +$y->walk( sub { + my( $node, $global ) = @_; + $global->{'total'} += $node->value; +}, $glob ); ``` - phi^n - 1/(-phi)^n -fn = ------------------ - sqrt 5 -``` - -Where `phi` is the golden ratio or 1.618,033,988 == (1+sqrt 5)/2, this -number crops up in many different places from art to nature. - -To speed up the calculation we compute `(phi^n)` and to get the second -value we note that this can be written as `(-1)^n/(phi^n)`. So we only -need to calculate `(phi^n)` once. Also we note `(-1)^n` can be -rewritten as `n&1?1:-1`; -In reality we don't even need to do this last trick, the contribution -to the sum of '(-1)^n/(phi^n)/sqrt 5' is going to be less than `0.5` -for all `n>=0` we can just reduce the formula to the first part to +### Walking the tree to update the nodes... -``` -fn = floor (phi^n/sqrt 5) -``` +We pass the variable $glob back in, and use the total there +to update the value. For the value to be the sum of all the +other nodes, we can get this by adding all the nodes together +than subtracting away the node value.... +So the 2nd half becomes. ```perl -sub climb_fib { - my $q = ((1 + sqrt 5)/2)**($_[0]+1); - return int(0.001+ ($q - ($_[0]&1?1:-1)/$q)*sqrt 0.2); -} - -sub climb_fib_1liner { - return int(0.001 + (($a = ((1+sqrt 5)/2)**($_[0]+1)) - ($_[0]&1?1:-1)/$a)*sqrt 0.2); -} - -sub climb_fib_approx { - return int(0.4 + (0.5+sqrt 1.25)**($_[0]+1)*sqrt 0.2); -} +$y->walk( sub { + my( $node, $global ) = @_; + $node->update( $global->{'total'} - $node->value ); +}, $glob ); ``` - -## Analysis and conclusion - -The following are data for computing all values up to "50 steps". - -| | Rate | climb | fib | fib-1 | cache | g-cch | fib-a | look | -| ----- | -------: | ----: | ----: | ----: | ----: | ----: | ----: | ----: | -| climb | 7,145/s | -- | -86% | -88% | -89% | -89% | -92% | -96% | -| fib | 52,854/s | 640% | -- | -8% | -16% | -21% | -39% | -72% | -| fib-1 | 57,208/s | 701% | 8% | -- | -9% | -14% | -34% | -70% | -| cache | 62,657/s | 777% | 19% | 10% | -- | -6% | -28% | -67% | -| g-cch | 66,489/s | 831% | 26% | 16% | 6% | -- | -23% | -65% | -| fib-a | 86,505/s | 1,111% | 64% | 51% | 38% | 30% | -- | -54% | -| look | 189,394/s | 2,551% | 258% | 231% | 202% | 185% | 119% | -- | - - - * Using "Binet's" formula we see we get approx `8x` the speed of - the original `climb` function. - * Using the approximation to Binet's formulate we see we get a factor - of about `12x` speed up. - * Using the cache seems to give about a `9x` speed gain - the `global` - variable version is better than the `state` version. - * Interestingly if you pre-compute the cache then the speed gain is - over `25x` to the original and `3x` times the speed of the basic - cache function - this is probably due to the overhead of checking - to see if the number is already in the cache. - -So some food for thought on how to best handle calls within tight loops. -- cgit From 49a097ceebb39b0f21d1e995f9975cdb646accc1 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Wed, 19 May 2021 13:01:13 +0100 Subject: Update README.md --- challenge-113/james-smith/README.md | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/challenge-113/james-smith/README.md b/challenge-113/james-smith/README.md index 621fc13607..2faccc1254 100644 --- a/challenge-113/james-smith/README.md +++ b/challenge-113/james-smith/README.md @@ -12,11 +12,9 @@ You can find the solutions here on github at: https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-113/james-smith/perl -# Challenge 1 - Canonical Path +# Challenge 1 - epresent Integer -**TASK #1: Represent Integer - -You are given a positive integer `$N` and a digit `$D`. Write a script to +**You are given a positive integer `$N` and a digit `$D`. Write a script to check if $N can be represented as a sum of positive integers having `$D` at least once. If check passes print `1` otherwise `0`.** -- cgit From 1b55021a620a4d525412b0fa0e3c012cb2d291b2 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Wed, 19 May 2021 13:01:48 +0100 Subject: Update README.md --- challenge-113/james-smith/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/challenge-113/james-smith/README.md b/challenge-113/james-smith/README.md index 2faccc1254..7ce644935d 100644 --- a/challenge-113/james-smith/README.md +++ b/challenge-113/james-smith/README.md @@ -12,7 +12,7 @@ You can find the solutions here on github at: https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-113/james-smith/perl -# Challenge 1 - epresent Integer +# Challenge 1 - Represent Integer **You are given a positive integer `$N` and a digit `$D`. Write a script to check if $N can be represented as a sum of positive integers having `$D` at -- cgit From e9b39d99075eeee987d3a516df331753ed4eed28 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Wed, 19 May 2021 13:05:38 +0100 Subject: Update README.md --- challenge-113/james-smith/README.md | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/challenge-113/james-smith/README.md b/challenge-113/james-smith/README.md index 7ce644935d..b2d866761d 100644 --- a/challenge-113/james-smith/README.md +++ b/challenge-113/james-smith/README.md @@ -67,7 +67,9 @@ solutions... ```perl sub represent { my( $t, $n, $d ) = ( 0, @_ ); - return 1 if $n >= 10 * ( $d || 10 ); + ## Type 2 solutions... + return 1 if $n >= 10 *A ( $d || 10 ); + ## Type 1 solutions... $n >= ( $t += $_ * 10 + $d ) && ( $n % 10 == $t % 10 ) && return 1 for 0..3; 0; @@ -80,11 +82,13 @@ variable and the `for` loop by "unrolling" the loop as below... ```perl sub represent_unrolled { my( $n, $d ) = @_; - $n >= 10 * ( $d || 10 ) || - $n >= $d && $n%10 == $d || - $n >= 2*$d+10 && !( ($n-2*$d)%10 ) || - $n >= 3*$d+30 && !( ($n-3*$d)%10 ) || - $n >= 4*$d+60 && !( ($n-4*$d)%10 ) ? 1 : 0; + ## Type 2 solutions... + $n >= 10 * ( $d || 10 ) || + ## Type 1 solutions... + $n >= $d && $n%10 == $d || + $n >= 2*$d+10 && !( ($n-2*$d)%10 ) || + $n >= 3*$d+30 && !( ($n-3*$d)%10 ) || + $n >= 4*$d+60 && !( ($n-4*$d)%10 ) ? 1 : 0; } ``` -- cgit From 28a5c0c801b40247935b10db065b90dfff934f88 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Wed, 19 May 2021 13:29:22 +0100 Subject: Update README.md --- challenge-113/james-smith/README.md | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/challenge-113/james-smith/README.md b/challenge-113/james-smith/README.md index b2d866761d..3d284e315c 100644 --- a/challenge-113/james-smith/README.md +++ b/challenge-113/james-smith/README.md @@ -212,10 +212,9 @@ The code itself is quite simple to look at... ```perl sub walk { my( $self, $fn, $global, $local, $dir ) = @_; - my ($v,$l,$r) = @{$self}; $local = $fn->( $self, $global, $local, $dir||'' ); - $self->left->walk( $fn, $global, $local, 'left' ) if defined $self->has_left; - $self->right->walk( $fn, $global, $local, 'right' ) if defined $self->has_right; + $self->left->walk( $fn, $global, $local, 'left' ) if $self->has_left; + $self->right->walk( $fn, $global, $local, 'right' ) if $self->has_right; return; } ``` -- cgit