201: Missing numbers and piles of pennies

Missing numbers

Task: We are given an array of unique numbers and asked to write a script to find out all missing numbers in the range 0 .. $n where $n is the number of entries in the array.

Analysis: The first thing to note is that there will always be at least one missing number, as there are $n + 1 numbers in the range 0 .. $n and only $n entries in the array.

The easy way to do this task is to convert the array to a string:

$string = ',' . join(',', @$array) . ',';

The string will look something like this:

,1,2,3,4,5,6,

Now all we have to do is to loop $j over 0 to $n - 1 and:

$result .= qq[$j, ] unless $string =~ m|,$j,|;

and with a little tidying up of the format, we have the result requested.

My solution

Penny piles

Task: We are given an integer, $n > 0, and asked to write a script to determine the number of ways of putting $n pennies in a row of piles such that each pile contains no fewer pennies than the one on its left.

Having given this some thought I decided to start with the rightmost, ie largest, stack and work backwards creating more, ever smaller stacks till I run out of pennies.

This is one of those tasks where recursion works well.  Let's define a subroutine find_ways($pennies, $height). Each time we call it, $pennies is the number of pennies we have still not stacked, and $height is the maximum height of the next stack.

So we're going to start with find_ways($n, $n), because we start with $n pennies and clearly the maximum height is also $n when all the pennies are in a single stack.

The essence of find_ways is just this:

for $h (1 .. ($pennies > $height ? $height : $pennies)) {
    find_ways($pennies - $h, $h);
}

What we're doing here is trying all the possible heights ($h) for the next stack from 1 up to the smaller of $pennies and $height.  It can't be more than $pennies, because that's all we've got and it can't be more than height or it would be higher than the stack on its right.

What happens when we run out of pennies? If that happens, find_ways will be called with $pennies == 0, and we have to trap that before we so the loop shown above.  The trap looks like this:

if ($pennies == 0) {
    $ways ++;
    return;
}

If you look at my solution you'll see that I have slightly complicated it so as to return the lists of piles as well as the number of ways the piles can be created.

My solution

Slicing and dicing a double century

 

200/1 = Arithmetic slices

You are given an array of integers, @array. Write a script to find out all Arithmetic Slices for the given array of integers. An integer array is called arithmetic if it has at least 3 elements and the differences between any three consecutive elements are the same.

Example:
Input: @array = (1,2,3,4)
Output: (1,2,3), (2,3,4), (1,2,3,4)

For ease, I decided to start by creating an array @diff, where $diff[$j] = $array[$j + 1] - $array[$j] - so I am looking for runs of 3 or more identical numbers in @diff. 

I move along @diff, maintaining a value $run_starts which is the index into @array where the current run of identical values of $diff[$j] starts, and $this_diff which is that value. Whenever I reach a $j which is not equal to $this_diff I know that $array[$j] is the end of the current run and potentially the start of another run.

Having identified a run of identical values of $diff[$j]:

• if it is less than 3 long I ignore it
• if it is 3 long, then I add it to the output
• if it is more than 3 long I add all its subsets as well - as in the example above

For convenience and clarity I have delegated that part of the task to subroutine &analyse.

In my submission I have added a number of edge cases, such as zero or negative numbers in @array, runs of negative differences, overlapping slices (eg 1, 2, 3, 6, 9).

My solution

200/2 = Seven segment 200

A seven segment display is an electronic component used to display digits. The segments are labelled 'a' through 'g' as shown:

The encoding of each digit can thus be represented compactly as a truth table:

my @truth =
    qw<abcdef bc abdeg abcdg bcfg acdfg acdefg abc abcdefg abcfg>;

For example, $truth[1] = ‘bc’. The digit 1 would have segments ‘b’ and ‘c’ enabled.

Write a program that accepts any decimal number and draws that number as a horizontal sequence of ASCII seven segment displays, similar to the following:

Given a digit to display, the truth table tells us which segments to 'light up', for example 'abdeg' for 2. We need to start with a blank 7x7 matrix and populate the appropriate positions with a symbol - either | or -. I decided to do that using another lookup table, which I created like this:

$digit[ord('a')] = '-00 -01 -02 -03 -04 -05 -06';
$digit[ord('b')] = '|16 |26';
$digit[ord('c')] = '|46 |56';
$digit[ord('d')] = '-60 -61 -62 -63 -64 -65 -66';
$digit[ord('e')] = '|40 |50';
$digit[ord('f')] = '|10 |20';
$digit[ord('g')] = '-30 -31 -32 -33 -34 -35 -36';

For each letter, a to g, I can then determine the symbol and the positions needed, for example 'a' needs a '-' in row 0, column 0; in row 0 column 1 and so on.

I build up the display in an 2-dimensional array @display, which is 7 rows high and 9n characters wide, where n is the number of digits to be displayed (9 rather than 7 to allow two blanks between successive digits). And this is how I do it:

$segments = $truth[$1];
while ($segments =~ m|(.)|g) {
    $points = $digit[ord($1)];
    while ($points =~ m|(.)(\d)(\d)|g) {
        $display[$2][$3 + $offset] = $1;
    }
}

Then it's just a case of printing @display with a \n after each row.

My solution

All good things

199/1 = Good pairs

We are given a list of integers, @list and asked to write a script to find the total count of Good Pairs.  A  pair (i, j) is called good if list[i] == list[j] and i < j.

If @list contains $n entries then the obvious way to do this is:

for $i (0 .. $n - 1) {
    for $j ($i + 1 .. $n) {
        if ($list[$i] == $list[$j]) {
            -- we have an answer
        }
    }
}

Doing the loops like this ensures that we have tested all possible values of $i, $j where $i < $j.

The test for $list[$i] == $list[$j] is performed ($n - 1)**2/2 times, but it is not obvious to me that there is a more efficient way of doing this.

199/2 = Good triplets

We are given an array of $n integers, @array and three integers $x, $y, $z and asked to write a script to find out total Good Triplets in the given array. 

The triplet $array[$i], $array[$j], $array[$k] is good if:

$i < $j < $k and
abs($array[$i] - $array[$j]) <= $x and
abs($array[$j] - $array[$k]) <= $y and
abs($array[$i] - $array[$k]) <= $z

Once again it seems inevitable that we perform nested loops:

for $i (0 .. $n - 2) {
    for $j ($i + 1 .. $n - 1) {
        for $k ($j + 1 .. $n) {
            if (abs($array[$i] - $array[$j]) <= $x
            and abs($array[$j] - $array[$k]) <= $y
            and abs($array[$i] - $array[$k]) <= $z) {
                -- we have an answer
            }
        }
    }
}

As before, the for loop limits impose $i < $j < $k and we only need to test the three differences against $x, $y and $z to identify good triplets.

If @array is long then this will be quite time-consuming, but we can optimise the algorithm somewhat because in the loop over $j we can already test for the first of the 'abs' conditions and skip the loop over $k:

for $i (0 .. $n - 2) {
    for $j ($i + 1 .. $n - 1) {
        next unless abs($array[$i] - $array[$j]) <= $x;

        for $k ($j + 1 .. $n) {
            if (abs($array[$j] - $array[$k]) <= $y
            and abs($array[$i] - $array[$k]) <= $z) {
                -- we have an answer
            }
        }
    }
}

Mind the gap!

Find the gap 

Our first task this week is to take a list of integers, sort it, and find all occurrences of the maximum gap between successive members of the list.

So let's start by sorting the list. You might - ok, some people might - think that this would work:

@list = sort @list;

but that's a trap we all fall into, because Perl treats the list items as text and therefore sorts 8, 9, 10 alphabetically as 10, 8, 9. So what we need is

@list = sort {$a <=> $b} @list;

which is a rather strange syntax that doesn't (I think) happen anywhere else in Perl.

Having done that we just need to loop over all the consecutive pairs of list members like this:

for $j (0 .. scalar(@list) - 2) {
    $gap = $list[$j + 1] - $list[$j];

If $gap is larger than any we've seen already, then we make a note of it ($max_gap) and set the count to 1, or if it's equal to $max_gap we increment the count. And that's it done.

Lesser primes

We are asked to find the number of primes less than a supplied number.

Many previous weeks' tasks have involved primes, so I had an implementation of the Sieve of Eratosthenes to hand. It's then just a case of counting them.

@sieve = make_sieve($test - 1);
$output = 0;
for $j (2 .. $test - 1) {   # ignore 1 and $test
    $output ++ if $sieve[$j];
}

Even with $test equal to a million, this only takes a couple of seconds to run.