This is my response to the Perl Weekly Challenge #54.
|
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: The script should print the 4th permutation sequence 231. |
We can do this in REPL, and permutations
is exactly what we need:
> (1..3).permutations
((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))
Note that
permutations gives a list well, actually a sequence, but the
destinction doesn't matter here. Note that this has nothing to do with
the «sequence» word in the challenge) of lists, as we can see if we add the
raku method:
> (1..3).permutations.raku
((1, 2, 3), (1, 3, 2), (2, 1, 3), (2, 3, 1), (3, 1, 2), (3, 2, 1)).Seq
The example asked for the fourth one, so we apply an index on the list. The first value has index (or offset) 0, so the fourth one has index 3:
> (1..3).permutations[3]
(2 3 1)
This is a list, so we can use join to combine
(or join) them into a single string:
> (1..3).permutations[3].join;
231
See
docs.raku.org/routine/permutations
for more information about permutations.
See
docs.raku.org/routine/raku
for more information about raku.
See
docs.raku.org/routine/join
for more information about join.
The challenge wanted a script where we can specify different values for n and k. That is easy:
File: kth-perm
unit sub MAIN (Int $n where $n >= 1, Int $k where $k >= 1);
say (1..$n).permutations[$k-1].join;
I have added constraints on the input variables. It is possible to use
a custom type (with subset), but that would add another line
of code to the program - and the where clauses work well
enough here.
Running it:
$ raku kth-perm 3 4
231
$ raku kth-perm 10 10
12345689107
|
It is thought that the following sequence will always reach 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. |
unit sub MAIN (Int $start where $start >= 1); # [1]
my $sequence := gather # [2]
{
take $start; # [3]
my $prev = $start; # [4]
loop # [5]
{
my $new = $prev %% 2 ?? $prev / 2 !! 3 * $prev + 1; # [6]
$prev = $new; # [7]
take $new; # [8]
last if $prev == 1; # [9]
}
}
say $sequence.join(", "); # [10]
[1] The same way of ensuring correct input as in challenge #54.1 (above).
[2]
gather/take is suitable
here.
[3] The initial value is the first one in the sequence.
[4] Note the current value, as the next one is derived from it.
[5] An eternal loop (with an exit strategy in [9]).
[6] Compute the next value. If the previous one was even
($prev %% 2 == 0), we halve it ($prev / 2),
and if not (it is odd), we apply the other rule (3 * $prev +1).
[7] As [4].
[8] Deliver the new value.
[9] We are finished when we reach «1», using last
to exit the loop.
[10] Print the sequence.
Running it:
$ collatz 23
23, 70, 35, 106, 53, 160, 80, 40, 20, 10, 5, 16, 8, 4, 2, 1
$ raku collatz 5
5, 16, 8, 4, 2, 1
$ raku collatz 4
4, 2, 1
$ raku collatz 3
3, 10, 5, 16, 8, 4, 2, 1
$ raku collatz 2
2, 1
$ raku collatz 1
1, 4, 2, 1
The last one is wrong. The problem is that the last condition
should come after the first 1, but that one comes before the loop.
And when we get to the loop, we have passed it (with the «4» as the current
value).
The solution is to move the condition to the start of the loop:
File: collatz (fixed)
unit sub MAIN (Int $start where $start >= 1);
my $sequence := gather
{
take $start;
my $prev = $start;
loop
{
last if $prev == 1;
my $new = $prev %% 2 ?? $prev / 2 !! 3 * $prev + 1;
$prev = $new;
take $new;
# last if $prev == 1;
}
}
say $sequence.join(", ");
Running it:
$ collatz 23
23, 70, 35, 106, 53, 160, 80, 40, 20, 10, 5, 16, 8, 4, 2, 1
$ raku collatz 5
5, 16, 8, 4, 2, 1
$ raku collatz 4
4, 2, 1
$ raku collatz 3
3, 10, 5, 16, 8, 4, 2, 1
$ raku collatz 2
2, 1
$ raku collatz 1
1
Looking good.
|
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. |
unit sub MAIN (Int $limit = 1_000_000, :$verbose, :$chop = 20); # [1]
my %length; # [2]
for 1 .. $limit # [3]
{
my @list = collatz($_); # [4]
%length{@list.elems}.push($_); # [5]
say "_ $_ -> @list[]" if $verbose;
}
my $count = 0; # [6]
my $elems; # [7]
for %length.keys.sort({ $^b <=> $^a }) -> $l # [8]
{
$elems = %length{$l}; # [9]
for @$elems # [10]
{
last if $count++ >= $chop; # [11]
say "{ $count }: Number $_ (with length $l)"; # [12]
}
}
sub collatz ($start) # [13]
{
my $sequence := gather
{
take $start;
my $prev = $start;
loop
{
last if $prev == 1;
my $new = $prev %% 2 ?? $prev / 2 !! 3 * $prev + 1;
$prev = $new;
take $new;
}
}
return $sequence;
}
[1] The first argument is positional. If we don't specify an integer
on the command line, it defaults to the value given in the challenge. Note
the underscores used to enhance human readability. The second one is a named
parameter, defaulting to False. The third one is (also) a named
parameter giving the chop off limit, with 20 as default value.
[2] We collect the length of the sequences in this one. The length is the index, and the value is a list of starting numbers.
[3] For every value we should compute,
[4] • get the Collatz sequence.
[5] • add the starting number and the length to the hash.
[6] The number of values we have printed so far as part of the solution. We use this to ensure that we don't exceed the chop off limit.
[7] The starting numbers for the given length.
[8] Iterate over the hash keys (the lengths), sorted as numbers. If we don't, the sort will be as strings.
[9] • get the list of starting numbers.
[10] • iterate over those numbers.
[11] • • exit the loop if we have reached the chop off limit.
[12] • • show the number.
[13] The procedure is an almost verbatim copy of the «collatz» program.
Running it with a low number:
$ raku collatz-1e6 100
1: Number 97 (with length 119)
2: Number 73 (with length 116)
3: Number 54 (with length 113)
4: Number 55 (with length 113)
5: Number 27 (with length 112)
6: Number 82 (with length 111)
7: Number 83 (with length 111)
8: Number 41 (with length 110)
9: Number 62 (with length 108)
10: Number 63 (with length 108)
11: Number 31 (with length 107)
12: Number 94 (with length 106)
13: Number 95 (with length 106)
14: Number 47 (with length 105)
15: Number 71 (with length 103)
16: Number 91 (with length 93)
17: Number 78 (with length 36)
18: Number 79 (with length 36)
19: Number 39 (with length 35)
20: Number 57 (with length 33)
And finally with the specified upper limit 1000000:
$ raku collatz-1e6
1: Number 837799 (with length 525)
2: Number 626331 (with length 509)
3: Number 939497 (with length 507)
4: Number 704623 (with length 504)
5: Number 910107 (with length 476)
6: Number 927003 (with length 476)
7: Number 511935 (with length 470)
8: Number 767903 (with length 468)
9: Number 796095 (with length 468)
10: Number 970599 (with length 458)
11: Number 546681 (with length 452)
12: Number 818943 (with length 450)
13: Number 820022 (with length 450)
14: Number 820023 (with length 450)
15: Number 410011 (with length 449)
16: Number 615017 (with length 447)
17: Number 886953 (with length 445)
18: Number 906175 (with length 445)
19: Number 922524 (with length 445)
20: Number 922525 (with length 445)
The program used 21 minutes on my pc this time, which is quite some time. It does a lot of calculations, so that is pretty much as expected.
And that's it.