I belong to a Facebook group called "Running after 60" (because, yes, I am that old, and yes, I run). There are some truly amazing stories in that group. Last month, there was a runner who tripped and broke his ankle on a 3:00am training run, two weeks before a marathon in the Utah mountains. He ran the marathon anyway. This past weekend, at the back of the pack in the Chicago marathon, was a runner who finished despite having three broken ribs. He had to finish because he didn't want his guides to be disqualified -- he's blind. Did I mention these people are over 60 years old?
So a little programming challenge is nothing. Let's do week 238!
Task 1 Running Sum
You are given an array of integers.
Write a script to return the running sum of the
given array. The running sum can be calculated as
sum[i] = num[0] + num[1] + ... + num[i].
Example 1 Input:
@int = (1, 2, 3, 4, 5)Output:(1, 3, 6, 10, 15)Example 2 Input:
@int = (1, 1, 1, 1, 1)Output:(1, 2, 3, 4, 5)Example 3 Input:
@int = (0, -1, 1, 2)Output:(0, -1, 0, 2)
Warmups
This is a straight-forward task. We could set up a loop over the elements and accumulate the sum, or we could do something more Perl-ish.
There is List::Util::reductions. It provides all the intermediate results from applying a block to consecutive pairs, leading to a single line solution:
use List::Util qw/reductions/;
say "(", join( ", ", reductions { $a + $b } @ARGV), ")";
But what if the 'a' and 'b' keys on the keyboard were broken? How would we persist? How about shifting things off the input and pushing them onto a list of sums; it's almost a one-liner:
sub runningSum(@int)
{
my @running;
my $sum = 0;
push @running, ($sum += shift @int) while @int;
return \@running;
}
Task 2 Persistence Sort
You are given an array of positive integers.
Write a script to sort the given array in increasing
order with respect to the count of steps required to
obtain a single-digit number by multiplying its digits
recursively for each array element. If any two numbers
have the same count of steps, then print the smaller
number first.
Example 1
Input:
@int = (15, 99, 1, 34)
Output:(1, 15, 34, 99)
15 => 1 x 5 => 5 (1 step)
99 => 9 x 9 => 81 => 8 x 1 => 8 (2 steps)
1 => 0 step
34 => 3 x 4 => 12 => 1 x 2 => 2 (2 steps)
Example 2
Input:
@int = (50, 25, 33, 22)
Output:(22, 33, 50, 25)
50 => 5 x 0 => 0 (1 step)
25 => 2 x 5 => 10 => 1 x 0 => 0 (2 steps)
33 => 3 x 3 => 9 (1 step)
22 => 2 x 2 => 4 (1 step)
Persistence of Memory
Thank goodness for examples; parsing that problem description was a challenge in itself. So it's a two-part problem: (1) we need to be able to convert a number to its step count, and (2) we want to sort by that step count.
Let's start by assuming we have part 1 in hand; let's say there's a function for Steps-To-Reduce-Number-To-One-Digit -- let's call it strnt1d -- that returns the number of steps like in the examples. Given that, we can sort the list by invoking the function in the comparison:
sort { strnt1d($a) <=> strnt1d($b) || $a <=> $b } @int
Good enough, probably. But strnt1d is going to be invoked twice every time that sort needs to do a comparison. Could we do better? How about if we make one pass just to get the step counts. If we save that list, then we can use both lists together to do the sorting. We can operate on indices, using the well-known computer science principal of solving problems via indirection.
my @step = map { strnt1d($_) } @int;
my @sorted = sort { $step[$a] <=> $step[$b] || $int[$a] <=> $int[$b] } 0..$#int;
return @int[@sorted]
What's that last step? Well, we sorted a list of indices, not the list of numbers. Once we know the order of indices, we have to take a slice of the original list to get the sorted order.
This indirection with an extra array is looking a little awkward. How could we do better? What if we had the step count attached to each value instead of off on the side? We can map each single value in @int to a pair: the original value, and its step count:
map { [ $_, strnt1d($_) ] } @int
which gives us an array of pairs that looks like
[ [15, 1], [99, 2], [1, 1], [34, 2] ]
Now we sort that list using the second element of each pair for the step count, and the first element of each pair to break ties:
sort { $a->[1] <=> $b->[1] || $a->[0] <=> $b->[0] } map {...}
The result is still an array of pairs, but now in order. From that we just need to extract the first member of each pair
map { $_->[0] } sort {...} map {...}
In one piece, it looks like
sub persistenceSort(@int)
{
return [ map { $_->[0] }
sort { $a->[1] <=> $b->[1] || $a->[0] <=> $b->[1] }
map { [ $_, strnt1d($_) ] } @int ];
}
I've made the result return an array reference instead of a list, because that makes it easier to fit into a testing framework.
In Perl lore, this trick of augmenting data with an additional trait, sorting it, and then discarding the trait is known as the Schwartzian Transform. I've also seen it done in shell scripts when specifying a sort field would be awkward. Instead, an awk or perl pipeline selects the sort criteria, prepends it to each line, and then after the sort runs, the sort field is cut off again.
Cool down
One bit of housekeeping left: we need to implement the strnt1d function that we assumed existed. There are two pretty easy ways to do it. If we treat a number as a string, we can split it into digits and multiply the digits:
use List::Util qw/product/;
sub strnt1d($n)
{
my $step = 0;
while ( $n > 9 )
{
++$step;
$n = product split(//, $n);
}
return $step;
}
Or we can apply math, picking off the least significant digit with modular arithmetic.
sub strnt1d($n)
{
my $step = 0;
while ( $n > 9 ) # Has more than one digit
{
$step++;
my $p = 1;
while ( $n ) # Create product of digits
{
$p *= $n % 10; # Least significant digit
$n = int($n/10); # Drop least significant digit
}
$n = $p; # Recursively apply to product
}
return $step;
}
There's also a purely recursive solution, which could use Memoize to cache intermediate results, but I believe this horse has been beaten enough. Time to finish the course and grab my banana and free T-shirt.
Top comments (0)