diff options
| -rwxr-xr-x | challenge-087/jo-37/perl/ch-1.pl | 48 |
1 files changed, 48 insertions, 0 deletions
diff --git a/challenge-087/jo-37/perl/ch-1.pl b/challenge-087/jo-37/perl/ch-1.pl new file mode 100755 index 0000000000..6eaeea9087 --- /dev/null +++ b/challenge-087/jo-37/perl/ch-1.pl @@ -0,0 +1,48 @@ +#!/usr/bin/perl + +use 5.012; +use Test2::V0; +use List::Util qw(reduce uniqnum); +use Data::Dump; + +# Find longest consecutive sequence in a list of integers. An empty +# result in boolean context gives zero as requested. +sub lcs { + # Sort unique values. + my @sorted = uniqnum sort {$a <=> $b} @_; + + # Abusing "reduce" as a sliding window implementation for two + # elements at a time. + # Transform the sorted list into sawtooth shape, where every number + # is shifted to zero if is not the successor of the previous. + my @sawtooth; + my $level; + reduce { + $level = $b if $b != $a + 1; + push @sawtooth, $b - $level; + $b + } '-inf', @sorted; + + # Find the maximum and simultanously its position in the list. + my $maxat = reduce { + $sawtooth[$b] > $a->[0] ? [$sawtooth[$b], $b] : $a + } ['-inf'], 0 .. $#sawtooth; + + # The longest consecutive list ends at the position of the maximum + # and has one more element than the maximum in the sawtooth list. + # Extract this sublist from the ordered list. Empty the result list + # if the maximum is zero, i.e. if the lcs consists of a single + # number. + (@sorted[$maxat->[1] - $maxat->[0] .. $maxat->[1]]) x !!$maxat->[0]; +} + +is [lcs 100, 4, 50, 3, 2], [2, 3, 4], 'Example 1'; +is lcs(20, 30, 10, 40, 50), F(), 'Example 2'; +is [lcs 20, 19, 9, 11, 10], [9, 10, 11], 'Example 3'; + +is [lcs 1, 2, 3, 11, 12, 13, 14, 21, 22], [11, 12, 13, 14], 'max != index'; +is [lcs 12, 3, 1, 14, 5, 2, 11, 3, 4, 13], [1, 2, 3, 4, 5], 'has duplicate'; +is [lcs 1, 2.1, 3.2, 4.3, 5.3, 6.3, 7.2, 8.1, 9], [4.3, 5.3, 6.3], + 'works with broken numbers, too'; + +done_testing; |