I’ve been doing the Perl Weekly
Challenges. The
latest
involved generating permutations and checking the Collatz Conjecture.

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.

I felt that the ordering of permutation sequences was not
well-defined, but the example gives lexical order, so that's what I
settled on. This means one doesn't have to generate the whole set of
permutations; rather, one can use the index number (k in this example)
to generate a Lehmer code that describes the individual permutation
desired.

```
use integer;
my ($n,$k)=@ARGV;
```

This means we need to convert the index into factorial base, and the
first step there is to generate a table of factorials.

```
my @f;
my $b=1;
my $v=1;
while ((scalar @f == 0) || $f[-1] < $k) {
push @f,$v;
$v*=$b;
$b++;
}
```

Then, starting with the highest factorial generated, do a standard
base conversion. (Note that the least significant digit is at the
start of the array. Also that the unmodified sequence, "first
permutation", is Lehmer code 0).

```
my $nk=$k-1;
my @n;
for (my $i=$#f;$i>=0;$i--) {
unshift @n,$nk/$f[$i];
$nk-=$f[$i]*$n[0];
}
```

Now we interpret that by pulling the indexed entries out of the
unpermuted sequence.

```
my @i=(1..$n);
my @o;
for (my $i=$n;$i>=1;$i--) {
my $f=$n[$i-1] || 0;
push @o,splice @i,$f,1;
}
print join($n>9?',':'',@o),"\n";
```

Perl6 is basically identical modulo syntax, except that we don't have
`use integer;`

. This has most of the fiddly differences that have been
tripping me up on previous occasions, so I'll include it in full.

```
my ($n,$k)=@*ARGS;
my @f;
my $b=1;
my $v=1;
while ((@f.elems == 0) || @f[@f.end] < $k) {
push @f,$v;
$v*=$b;
$b++;
}
my $nk=$k-1;
my @n;
loop (my $i=@f.end;$i>=0;$i--) {
unshift @n,floor($nk/@f[$i]);
$nk-=@f[$i]*@n[0];
}
my @i=(1..$n);
my @o;
loop (my $j=$n;$j>=1;$j--) {
my $f=@n[$j-1] || 0;
push @o,splice @i,$f,1;
}
say join($n>9 ?? ',' !! '',@o);
```

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

$n = $n / 2 when $n is even
$n = 3*$n + 1 when $n is odd
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.

Well, that's obvious enough:

```
use integer;
while (my $n=shift @ARGV) {
my @k=($n);
while ($n != 1) {
if ($n % 2 == 0) {
$n/=2;
} else {
$n*=3;
$n++;
}
push @k,$n;
}
print join(', ',@k),"\n";
}
```

and Perl6 differs only as needed.

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.

One could do this by brute force, but one can short-cut evaluation by
keeping a log of the length of each sequence that's already been
evaluated. So in the example above, by the time we get to 23, we've
already evaluated 20, so we don't need to recalculate the last seven
steps from 20 down to 1.

```
use integer;
my %l;
my %s;
$l{1}=1;
foreach my $n (1..1e6) {
my $k=1;
my $na=$n;
while (!exists $l{$na}) {
if ($na % 2 == 0) {
$na/=2;
} else {
$na*=3;
$na++;
}
$k++;
}
$l{$n}=$k+$l{$na};
push @{$s{$l{$n}}},$n;
}
```

The keys of `%s`

are sequence lengths and the values are lists of
starting numbers that give that length of sequence, so we just iterate
down the keys until we've printed enough numbers.

```
my $k=20;
foreach my $c (sort {$b <=> $a} keys %s) {
print "$c: ".join(', ',sort @{$s{$c}}),"\n";
$k-=scalar @{$s{$c}};
if ($k<=0) {
last;
}
}
```

The whole thing takes about 3½ seconds on my desktop machine. A
potentially faster approach, though it would use more memory, would be
to retain indices for the entire sequence; "26" already appears in the
sequence for "7" so no new calculations need be done at all. However,
on the same machine this version takes a little over 5 seconds.

I didn't do this one in Perl6; the syntax needed for its equivalent of
`push @{$s{$l{$n}}},$n`

with autovivification eluded me.

Comments on this post are now closed. If you have particular grounds for adding a late comment, comment on a more recent post quoting the URL of this one.