Perl Weekly Challenge: Week 54

Challenge 1:

kth Permutation Sequence

Write a script to accept two integers n (>=1) and k (>=1). It should print the kth permutation of n integers. For more information, please follow the wiki page.

For example, n=3 and k=4, the possible permutation sequences are listed below:

  123
  132
  213
  231
  312
  321

The script should print the 4th permutation sequence 231.

We can do this in Raku as a one-liner.

perl6 -e 'my ($n, $k) = @*ARGS; (1 .. $n).permutations[$k - 1].join(q{}).say;'

(Full code on Github.)

Perl doesn't have a builtin permutation method but back in challenge 43 I used one based on an answer from the perlfaq4 POD page and I reused it here. Now the solution is almost as simple as in Raku.

my @permutations;
permute { push @permutations, \@_; } (1 .. $n);
say join q{}, @{ $permutations[$k - 1] };

(Full code on Github.)

Challenge 2:

Collatz Conjecture

It is thought that the following sequence will always reach 1:

For example, if we start at 23, we get the following sequence:

23 → 70 → 35 → 106 → 53 → 160 → 80 → 40 → 20 → 10 → 5 → 16 → 8 → 4 → 2 → 1

Write a function that finds the Collatz sequence for any positive integer. Notice how the sequence itself may go far above the original starting number.

Extra Credit

Have your script calculate the sequence length for all starting numbers up to 1000000 (1e6), and output the starting number and sequence length for the longest 20 sequences

The sequence is easy to model in Perl. Given an integer $n. the function below returns a list containing the elements of the sequence.

sub collatzSequence {
    my ($n) = @_;
    my @sequence = ($n);

    while ($n != 1) {
        $n = ($n % 2) ? (3 * $n + 1) : ($n / 2);
        push @sequence, $n;
    }

    return @sequence;
}

The extra credit required some more work. My naive solution was to run the collatzSequence() function one million times, storing each number and the length of its' Collatz sequence as values in a hash. Then I sorted the hash and extracted the 20 longest. While this works, it is very wasteful of memory. We are keeping around 999,980 useless elements for the 20 that we do need. There has to be a better way.

What the code below does instead is to work out the Collatz sequence. Once again we add the number and the length of its sequence into a data structure (the @longest array) but only if the length is equal to or larger than $maxlength which is equal to the smallest value currently in the list. (If the array is empty, $maxlength is just set to this value.) @longest is kept sorted in order of descending sequence length. If the size of this list is over 20, the last (i.e. the smallest value) element is removed. This is much more memory-efficient.

my $maxlength = 0;
my @longest = ();

for my $n (1 .. 1e6) {
    my $length = scalar collatzSequence($n);

    if ($length >= $maxlength) {
        $maxlength = (scalar @longest) ? $longest[-1]->[1] : $length;
        push @longest, [$n, $length];

        @longest = sort {$b->[1] <=> $a->[1] } @longest;
        if (scalar @longest > 20) {
            pop @longest;
        } 
    }
}

Finally the starting number and sequence length for the longest 20 sequences are displayed.

for my $long (@longest) {
    say $long->[0], ': ', $long->[1];
}

(Full code on Github.)

In Raku, the Collatz sequence can be coded even more succintly as a lazy list.

sub collatzSequence(Int $n) {
    return ($n, { ($_ % 2) ?? (3 * $_ + 1) !! ($_ / 2) } ... 1);
}

The extra credit part is a straightforward port of the Perl code so I won't bother repeating it here but I must make one observation. For one million integers Raku is S L O W. Perl takes a couple of minutes, Raku takes close to half an hour. I love using this language but it has a long way to go before it is production ready I'm afraid.

(Full code on Github.)