From 3d582d8fd55cef900675a2aa5885d18ab7b8ed82 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Tue, 29 Sep 2020 08:41:04 +0100 Subject: re-written with test-more tests and added additional tests to ensure that the ch-2.pl was working correctly as the examples in the blog could be solved with code which terminated prematurely [you need to repeat the application of rule 2 until you add no new candies] - and looking at some of the solutions this is the case --- challenge-080/james-smith/perl/ch-1.pl | 14 ++++++++++---- challenge-080/james-smith/perl/ch-2.pl | 18 +++++++++++------- 2 files changed, 21 insertions(+), 11 deletions(-) (limited to 'challenge-080') diff --git a/challenge-080/james-smith/perl/ch-1.pl b/challenge-080/james-smith/perl/ch-1.pl index 09526718d6..b0c63324fa 100644 --- a/challenge-080/james-smith/perl/ch-1.pl +++ b/challenge-080/james-smith/perl/ch-1.pl @@ -5,13 +5,19 @@ use warnings; use feature qw(say); -say smallest_number_sort(qw(200 1 -2 2 5 1000 -6 3000 ),1e6..1e7,6001..9001,3,4,3401..5900); -say smallest_number_sort(qw(5 2 -2 0)); -say smallest_number_sort(qw(1 8 -1)); -say smallest_number_sort(qw(2 0 -1)); +use Test::More; + +is( smallest_number_sort( qw(200 1 -2 2 5 1000 -6 3000 ),6001..9001,3,4,3401..5900 ), 6 ); +is( smallest_number_sort( qw(5 2 -2 0) ), 1 ); +is( smallest_number_sort( qw(1 8 -1) ), 2 ); +is( smallest_number_sort( qw(-10 -8 -1) ), 1 ); +is( smallest_number_sort( qw(2 0 -1) ), 1 ); + +done_testing; sub smallest_number_sort { my @q = sort { $a <=> $b } grep {$_>0} @_; ## Need +ve in order! + return 1 unless @q; ## No positive integers - avoids warn in next line for( $_=1; $_ == shift @q; $_++ ) {} ## Loop through from 1.. exit loop if the array ## value isn't equal to index (1-based) return $_; ## return value... diff --git a/challenge-080/james-smith/perl/ch-2.pl b/challenge-080/james-smith/perl/ch-2.pl index 9116f85539..a8eacfb22e 100644 --- a/challenge-080/james-smith/perl/ch-2.pl +++ b/challenge-080/james-smith/perl/ch-2.pl @@ -5,20 +5,24 @@ use warnings; use feature qw(say); -say candies( qw(1 2 2) ); -say candies( qw(1 4 3 2) ); +use Test::More; + +is( candies( qw(1 2 2) ), 4 ); +is( candies( qw(1 4 3 2) ), 7 ); +is( candies( qw(5 4 3 2 1) ), 15 ); +is( candies( qw(2 1 2 1 2 1 2) ), 11 ); + +done_testing; sub candies { my @ranks = @_; - my $prev_count = @candies = map { 1 } @ranks; ## First pass we set everything to 1! + my $prev_count = my @candies = map { 1 } @ranks; ## First pass we set everything to 1! my $flag; do { my $count = 0; foreach( 0..(@ranks-2) ) { ## Loop through comparing element to next one - increase as approprite - - $candies[$_] = $candies[$_+1]+1 if ($ranks[$_] > $ranks[$_+1]) && ($candies[$_] <= $candies[$_+1]); - $candies[$_+1] = $candies[$_ ]+1 if ($ranks[$_] < $ranks[$_+1]) && ($candies[$_] => $candies[$_+1]); - + $candies[$_+1] = $candies[$_ ]+1 if $ranks[$_] < $ranks[$_+1] && $candies[$_] >= $candies[$_+1]; + $candies[$_] = $candies[$_+1]+1 if $ranks[$_] > $ranks[$_+1] && $candies[$_] <= $candies[$_+1]; $count += $candies[$_ ]; ## by the time we get here we would have done both comparisons that ## cause this entry to be updated.. } -- cgit From 0911e211582f663efb0806b2c39a7d447765071a Mon Sep 17 00:00:00 2001 From: drbaggy Date: Tue, 29 Sep 2020 08:50:55 +0100 Subject: rewrite with a left to right and a right to left pass - this doesn't need the outer loop --- challenge-080/james-smith/perl/ch-2.pl | 27 +++++++++++++-------------- 1 file changed, 13 insertions(+), 14 deletions(-) (limited to 'challenge-080') diff --git a/challenge-080/james-smith/perl/ch-2.pl b/challenge-080/james-smith/perl/ch-2.pl index a8eacfb22e..c263204651 100644 --- a/challenge-080/james-smith/perl/ch-2.pl +++ b/challenge-080/james-smith/perl/ch-2.pl @@ -10,6 +10,7 @@ use Test::More; is( candies( qw(1 2 2) ), 4 ); is( candies( qw(1 4 3 2) ), 7 ); is( candies( qw(5 4 3 2 1) ), 15 ); +is( candies( qw(5 4 3 4 3 2 1) ), 16 ); is( candies( qw(2 1 2 1 2 1 2) ), 11 ); done_testing; @@ -18,18 +19,16 @@ sub candies { my @ranks = @_; my $prev_count = my @candies = map { 1 } @ranks; ## First pass we set everything to 1! my $flag; - do { - my $count = 0; - foreach( 0..(@ranks-2) ) { ## Loop through comparing element to next one - increase as approprite - $candies[$_+1] = $candies[$_ ]+1 if $ranks[$_] < $ranks[$_+1] && $candies[$_] >= $candies[$_+1]; - $candies[$_] = $candies[$_+1]+1 if $ranks[$_] > $ranks[$_+1] && $candies[$_] <= $candies[$_+1]; - $count += $candies[$_ ]; ## by the time we get here we would have done both comparisons that - ## cause this entry to be updated.. - } - - $count += $candies[-1]; ## Add count for the last element... - - return $count if $count == $prev_count; ## Totals are the same so nothing been update can return - $prev_count = $count; - } while( 1 ); ## Infinite loop - will hit exit condition in loop...! + ## Sweep left first... + foreach( 0..(@ranks-2) ) { + $candies[$_+1] = $candies[$_]+1 if $ranks[$_] < $ranks[$_+1] && $candies[$_] >= $candies[$_+1]; + } + ## Then sweep right... we have to go right to left otherwise you don't get the right answer + ## at the end... + foreach( reverse 1..(@ranks-1) ) { + $candies[$_-1] = $candies[$_]+1 if $ranks[$_] < $ranks[$_-1] && $candies[$_] >= $candies[$_-1]; + } + my $t = 0; + $t+= $_ foreach @candies; + return $t; } -- cgit