PERL WEEKLY CHALLENGE – 054

This is my 24th week participating into the weekly challenge.


TASK #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.


For Perl and Raku, I got lazy and just used the perl 5 https://metacpan.org/pod/Algorithm::Combinatorics permutations method and the Raku permutations method

No real magic after that than displaying the kth – 1 element of the permutations array.

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch-1.pl 3 4
use strict;
use warnings;
use feature qw /say/;
use Algorithm::Combinatorics qw(permutations);

my $n = $ARGV[0];
my $k = $ARGV[1];

my @data = 1 .. $n;
my @all_permutations = permutations(\@data);
say join '', @{$all_permutations[$k - 1]};

Output

231

Raku solution

# Test: perl6 ch-1.p6 3 4
sub MAIN(Int $n, Int $k) {
	[1 .. $n].permutations[$k - 1].join.say;
}

Output

231

TASK #2

Collatz Conjecture

Contributed by Ryan Thompson

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.

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.


For this task I did the extra credit and just Brute forced the collatz calculation. To save some memory I just stored the lengths of collatz length greater than 440 and displayed the first 22. (I displayed the first 22 because there are quite a few numbers with length 445 and wanted to be fair to them all)

Warning: Raku solution is slow. Very slow. …. like really really slow

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch-2.pl
use strict;
use warnings;
use feature qw /say/;

# Brute force calculate collatz
my %lengths;
for my $i (1 .. 1_000_000) {
	my $length = collatz($i);
	$lengths{$i} = $length
		if ($length > 440);
}

# Grab the 22 longest numbers
my @keys = (
	sort {
		$lengths{$b} <=> $lengths{$a}
	} keys %lengths
)[0 .. 21] ;

for my $i ( @keys ) {
	say "$i : Length " . $lengths{$i};
}

#Calculate collatz
sub collatz {
	my $n = shift;
	my $length = 0;

	while ($n != 1) {
		$length++;

		$n = ($n % 2) ?
			3 * $n + 1  :
			$n / 2;
	}

	return $length;
}

Output

837799 : Length 524
626331 : Length 508
939497 : Length 506
704623 : Length 503
927003 : Length 475
910107 : Length 475
511935 : Length 469
796095 : Length 467
767903 : Length 467
970599 : Length 457
546681 : Length 451
820023 : Length 449
820022 : Length 449
818943 : Length 449
410011 : Length 448
615017 : Length 446
922525 : Length 444
922526 : Length 444
906175 : Length 444
886953 : Length 444
938143 : Length 444
922524 : Length 444

Raku solution

# Test: perl6 ch-2.p6
sub MAIN() {

	# Brute force calculate collatz
	my %lengths;
	for (1 .. 1_000_000) -> $i {
		my $length = collatz($i);
		%lengths{$i} = $length
			if ($length > 440);
	}

	# Grab the 22 longest numbers
	my @keys = %lengths.keys.sort(
		{ %lengths.{$^b} <=> %lengths.{$^a} }
	).[0 .. 21];

	# Output the lengths
	for ( @keys ) -> $i {
		say "$i : Length " ~ %lengths{$i};
	}
}

#Calculate collatz
sub collatz($n is copy) {
	my $length = 0;

	while ($n != 1) {
		$length++;

		$n = ($n % 2) ??
			3 * $n + 1  !!
			$n / 2;
	}

	return $length.Int;
}

Output

837799 : Length 524
626331 : Length 508
939497 : Length 506
704623 : Length 503
927003 : Length 475
910107 : Length 475
511935 : Length 469
796095 : Length 467
767903 : Length 467
970599 : Length 457
546681 : Length 451
820023 : Length 449
820022 : Length 449
818943 : Length 449
410011 : Length 448
615017 : Length 446
922525 : Length 444
922526 : Length 444
906175 : Length 444
886953 : Length 444
938143 : Length 444
922524 : Length 444

One thought on “PERL WEEKLY CHALLENGE – 054

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s