Dates, and more recursively defined numbers

Last Sundays 

For task 1 we are asked to write a script to list the last Sunday of every month of a given year.

The first decision is which modules we're allowed to use, but in the interests of revealing the logic I only used timelocal_posix, which is the inverse of the built-in localtime (apart from a few irrelevant provisos).

It's a slightly awkward calculation. There can be 4 or 5 Sundays in a month, and that depends on the day of the week the month starts on and how many days there are in the month. So I hit on the idea of looking at the 12 months starting with the February of the given year.  If we take the 1st of each of these 12 months, we can construct the Unix time of noon like this:

$time = timelocal_posix(0, 0, 12, 1, $month, $year - 1900);

and then use timelocal to get the day of the week as $t[6] in:

@t = localtime($time);

Then, to get the last Sunday of the preceding month, if the 1st of the month is a Sunday ($t[6] == 0) we need to move back 7 days, or otherwise we just move back $t[6] days. To do that we subtract 86400 seconds for each day we're moving back, and then a final localtime gives us the desired date.

The vanilla version of timelocal works for nearby dates, but the Posix version can cover (at least) 1753 - 3999 in the Gregorian calendar.

Perfect totients

Task 2 requires to write a script to generate the first 20 Perfect Totient Numbers. To do this for a given number n, we first count the mutually prime lesser integers (including 1) with which it is mutually prime - or equivalently, those with which it has a greatest common divisor of 1.

Having got this count, we repeat the process on it - that is, count its lesser mutual primes, and so until we get to 1. Clearly it will always converge to 1, because the count of positive integers less than n will always be less than n.

So how to do this? First I wrote (borrowed, actually) a gcd function, and then wrote a totients_count function.  That's enough for the first few perfect totients, but as they get bigger it takes longer, so I had totients_count cache its results in an array, and checked for an answer there before calling totients_count again.

On my quite slow machine it took about 1.5 minutes to get the required 20 numbers.

Disarium disaster and rank permutations

Disarium numbers

We are asked to write a script to generate first 19 Disarium numbers. A Disarium number is an integer where the sum of each digit raised to the power of its position in the number, is equal to the number.

Clearly 1 to 9 inclusive are Disarium numbers because they all contain 1 digit and n ^ 1 == n.

The next 8 are easily found, ranging from 89 to 2427. One further one needs a little more effort: 2646798.  I found them simply by examining 1 .. (big integer). It pays to do the examination from the last digit back to the first, because you can give up as soon as the sum exceeds the number under examination.

So there's 18 of them without much effort. But what of the nineteenth?

I left my algorithm running while I had a leisurely lunch (it's 39 degrees here, after all) and came back to find ... nothing.  So if there are any more DNs, they are quite big.

But, aha! Mohammad didn't specify where we should start, so I am claiming that 0 is a Disarium number, because 0^1 == 0, and that makes 2646798 the 19th.

So Disarium disaster averted!

Ranking permutations

Mohammad tells us that we are given a list of integers with no duplicates, e.g. [0, 1, 2] and are to write two functions: 

• permutation2rank() which will take the list and determine its rank (starting at 0) in the set of possible permutations arranged in lexicographic order, and 
• rank2permutation() which will take the list and a rank number and produce just that permutation.

He also kindly point us to an algorithm - and even some sample code.  I have to say I didn't find the permutation2rank code too easy to follow, but from the textual description above it I more-or-less did the same in Perl.

The algorithm insists on the permuted set being a set of consecutive integers starting from 0, and while Mohammad doesn't restrict us to that, I think it's good enough for a hot afternoon.

The slightly tricky bit is that as you create a single permutation, your choice of what comes next gets steadily less. So given 0, 1, 2, 3, 4, you've got a choice between 5 options for the first digit of your perm, but only 4 for the next now that you've used up one digit already, and once you get to the 5th digit you've already used up 4 of the 5 and have no choice left for the fifth.

So the principal of the algorithm is to calculate the contribution to the rank from each digit, and add them together. If we are given 3, 2, 1, 0 we first calculate where the 3s start, then the offset from there to where the 3, 2s start, then the offset to where the 3, 2, 1s start - and of course that's also where they finish, because there's only one perm - 3, 2, 1, 0.

I chose to do this slightly differently from the linked article by maintaining an array @ranks.  For, say, a six-member perm, @ranks start out like this:

@ranks == [0, 1, 2, 3, 4, 5]

Let's say our given perm is [3, 4, 2, 1, 0].  Where do the perms starting with 3 start in the ranking? Well, after the 3 blocks of 0s, 1s and 2s. If I know (and I do) how big these blocks are, I know that our rank is going to be at least 3 of these big blocks.

Now we come to the second component of the perm which is 4. Now you might think that there will be 4 smaller blocks - the ones starting 3, 0; 3,1 ;3,2 ; 3,3 ... but no! that's not right because there won't be a 3, 3 because we've already used the only 3.

So backtrack a bit. After we did the first block of 3s, we need to eliminate 3 from the rankings and that's where @ranks comes in. After we've used 3, we change @ranks to be:

@ranks == [0, 1, 2, -1, 3, 4]  

The second element of our given perm is 4, and it's rank (within the block starting with 3) is $rank[4] - which is 3. It's in the 4th (counting from 0) sub-block after 3, 0; 3,1 and 3,2.

It is rather complex and hard to get your head round, but I hope that helps a bit.

So now we come to rank2permutation. The logic is quite similar: again we are looking at blocks starting with the same 0th, 1st, 2nd ... numbers and deducing where our desired row sits.

I've provided an example where the perm is 15 numbers, ie 0 ..14. Soon after that we'll run out of integers, but that's for another day.

Aesthetics and a fast-growing sequence

Esthetic numbers

This week's task 1 is to write a script to find out if a given number is an Esthetic Number. An Esthetic Number is one where successive digits differ by 1.

We may deduce:

• They were named by an American
• The digits may differ by ±1 

There seems little option but to start at one end and compare each digit to the next one in the direction of travel.  The evidence from past challenges is that substr() is faster than pulling them out with a regular expression, so let's use that.

Method 1 - fast but non-compliant

We can comply with the instruction by declaring a number unaesthetic as soon as we find two consecutive digits which differ by >1. If we treat the given number as a string, we don't need to worry about exceeding Perl's maximum integer: we're only ding arithmetic on 0 .. 9.

Method 2 - matching Mohammad's example output

Mohammad gives us as an example:

120 is not an esthetic number as |1 - 2| != |2 - 0| != 1

It is unfortunately not very clear whether the 'as' clause would be the same for 1207. Would he give up after the 0, or continue to the end:

1207 is not an esthetic number as |1 - 2| != |2 - 0| != 1
1207 is not an esthetic number as |1 - 2| != |2 - 0| != |0 - 7| != 1

I thought it was safer to assume he might mean the second of these, so I have given two solutions, one which just gives the first unesthetic pair and the other which parses the entire number.  But this is slightly tricky as each '=' or '!=' (except the last) depends on 3 digits. For example, in my second example above, the first '!=' depends on 1, 2 and 0.

As a toxic example, 

2468 is not an esthetic number as |2 - 4| = |4 - 6| = |6 - 8| != 1

Note that the only '!=' comes at the end.

Of course, for any reasonable-sized number the difference in speed is unmeasurably small.

Sylvester's sequence

I had rather hoped that this was discovered by the eponymous cat:

but it seems that James Joseph Sylvester was responsible.  The sequence start with 2, 3, and each subsequent term is the product of all the preceding ones, plus one.

A little reflection reveals that:

• This is going to get big as fast as a pumpkin
• So we'd better resort to Math::BigInt

We can save microseconds by noting that term n really only depends on term n -1. Specifically:

s(n) = (s(n-1) - 1) * s(n-1) + 1

And once we have conquered the challenge of expressing that in BigInt-ian:

$sylvester[$j] = Math::BigInt->new(0)  # zero

->badd($sylvester[$j - 1])     # plus the preceding term

->bsub(Math::BigInt->new(1))   # minus 1 

->bmul($sylvester[$j - 1])     # times the preceding one

->badd(Math::BigInt->new(1));  # plus 1

we have our solution.  We are asked for the first 10 terms, and the tenth turns out to be 165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443, which confirms the decision to use BigInt.

Tricky partitions and easy stats

Prime partitions

Task 1 this week asks:

You are given two positive integers, $m and $n. Write a script to find out the Prime Partition of the given number. No duplicates allowed. For example,

Input: $m = 18, $n = 2
Output: 5, 13 or 7, 11

Input: $m = 19, $n = 3
Output: 3, 5, 11

The internet tells us that a prime partition is a set of prime numbers that add up to a given number.  From the examples, I think we can deduce:

• $m is the given number for which we are to find certain prime partitions
• These partition sets must contain $n members
• These members must be distinct
• 1 is not regarded as a usable prime number
• We are to report all possible sets for a given $m
• We are report the members of the set in increasing order (ie 5,13 not 13, 5)

The simple-minded way to do this is to check all the sums of $n prime numbers which are less than $m and somewhere in there we will find the result.  There are a few efficiencies we can apply: for example, if $n == 3, having selected two primes whose sum already exceeds $m there is no point in looking at a third.

This problem is one of nested loops, and the number of loops is variable. Such problems are often best solved by recursion, and that's what I did.  I wrote a function fill_gap($gap, $count) which finds all the possible sets of $count primes that sum to $gap.  

I use 'gap' to mean difference between $m and the incomplete set of primes I am currently testing.  So for the second of Mohammad's examples, the gap is initially 19, but when I am testing 3 as the first prime, the gap is now 16.

So what does fill_gap do? We start by calling fill_gap($m, $n) - we are looking for all the sets of $n qualifying primes that sum to $m.  And here's what fill_gap does:

• If $count == 1, it checks to see if $gap is prime, and if so we have a result!
• If $count == 1 and $gap is not prime then we know that there is no answer involving the previous set of $n - 1 primes we are testing.
• If $count > 1 then we loop downwards over all the primes ($j) less than $gap, calling fill_gap($gap - $j, $count - 1) to fill the remaining gap.

So does it work?  Well, yes, of course.  It works pretty well for smallish numbers. For example $m = 101, $n = 4 finds 21 answers in milliseconds.  For large $m it is still quite efficient: $m = 501, $n = 4 takes about 5 seconds (on my Raspberry Pi). However, if you start increasing $n, $m = 501, $n = 5 takes about 2 minutes.

Five number summary

Task 2 says: You are given an array of integers. Write a script to compute the five-number summary of the given set of integers.

The 5-number summary comprises minimum, first (or lower) quartile, median, third (or upper) quartile and maximum.  To do this, we first sort the array.  The minimum and maximum values are now the first and last elements.  If there is an odd number of elements in the array, the middle one is the median; if there is an even number then the average of the two elements that straddle the middle is  the median.

A similar process is used to find the first and third quartiles. For example, if there are 10 numbers in the set, s[0] to s[9], the median is the average of s[4] and s[5], the first quartile is 0.75 of item s[2] plus 0.25 of item s[3] and the third quartile is 0.25 of item s[6] plus 0.75 of item s[7].

Of course there are modules to do all this, but it's only a dozen lines of simple coding to do it from first principles.

Abundantly odd and ... Oh dear!

 Abundant odd numbers

Task 1 asks us to write a script to generate first 20 Abundant Odd Numbers (AONs). Wikipedia tells us that n is an abundant number if the sum of its divisors (including itself) σ(n) > 2n.  Some abundant numbers are even, but we only want the odd ones.

Finding the divisors of a number isn't too hard, but I save myself the trouble by invoking Math::Prime::Util qw(divisors), and simply by checking successive odd integers we get the required 20 AONs in milliseconds. The 20th AON is 8925, so we don't need BigInt, and in fact the 200th is 92925 and even the 2000th is a manageable 1002375.

References to functions

Task 2 asks:

Create sub compose($f, $g) which takes in two parameters $f and $g as subroutine refs and returns subroutine ref i.e. compose($f, $g)->($x) = $f->($g->($x))

Hmm.

I have written something like a million lines of code over 50 years in IT, and the number of times I have felt the need for a reference to a function is quite small - in fact I can only remember one occasion.  So perhaps my unfamiliarity helps to explain why I don't really grasp the question.

So I shall not submit an attempt this time, and will read others' responses with some interest.