RogerBW's Blog

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.