This is my response to the Perl Weekly Challenge #58.
|
You are given a linked list and a value k. Write a script to partition the linked list such that all nodes less than k come before nodes greater than or equal to k. Make sure you preserve the original relative order of the nodes in each of the two partitions. For example: Linked List: 1 → 4 → 3 → 2 → 5 → 2 k = 3 Expected Output: 1 → 2 → 2 → 4 → 3 → 5. |
«You are given a linked list» is wonderfully devoid of details. I have chosen to let the user specify the list on the command line, and use a list (an ordered list), and ignore the «linked» part.
There are two ways we can get a user specified list; either as a (space separated) string or as individual arguments. I'll support both.
File: linked-list
multi MAIN (Int $k = 3, Str $list = "1 4 3 2 5 2", :$verbose) # [1]
{
MAIN($k, $list.words, :$verbose); # [2]
}
multi MAIN (Int $k = 3, *@list, :$verbose) # [3]
{
my @lower; # [4]
my @higher; # [5]
for @list -> $elem # [6]
{
$elem >= $k # [7]
?? @higher.push: $elem # [7a]
!! @lower.push: $elem; # [7b]
}
my @result = (@lower, @higher).flat; # [8]
if $verbose
{
say ": == : $k";
say ": < : @lower[]";
say ": >= : @higher[]";
}
say @result.join(" → "); # [9]
}
[1] The first version of «MAIN» takes «k» and a string,
[2] then it splits the string and calls the second version of «MAIN».
[3] The second version of «MAIN» takes
«k», and then a list of values (gobbled up by the slurpy argument
*@list).
[4] Two lists, where we collect the values. This one has lower than «k»,
[5] and this one has higher than or equal to «k».
[6] Go through the values,
[7] If the current value is higher or equal to «k», put it in
@higher [7a], else put it in @lower.
[8] Merge the lists. Note the flat so that we
get one list (and not a list containing two sublists).
[9] The challenge wanted array symbols, so here they are.
See
docs.raku.org/routine/flat
for more information about flat.
Running it:
$ raku linked-list
1 → 2 → 2 → 4 → 3 → 5
$ raku linked-list --verbose
: == : 3
: < : 1 2 2
: >= : 4 3 5
1 → 2 → 2 → 4 → 3 → 5
With a user specified list (either as a list, or a string):
$ raku linked-list --verbose 3 1 4 3 2 5 2
: == : 3
: < : 1 2 2
: >= : 4 3 5
1 → 2 → 2 → 4 → 3 → 5
$ raku linked-list --verbose 3 "1 4 3 2 5 2"
: == : 3
: < : 1 2 2
: >= : 4 3 5
1 → 2 → 2 → 4 → 3 → 5
Here is a version with a real linked list, though it is constructed after the sorting:
File: linked-list-linked (changes only)
...
say @result.join(" → ") if $verbose; # [0]
class ListElem # [1]
{
has $.value; # [1a]
has $.next is rw; # [1b]
method display # [2]
{
print $.value; # [2a]
if $.next { print " → "; $.next.display; } else { say ""; } # [2b]
}
}
my $head; # [3]
$head = ListElem.new(value => $_, next => $head) for @result.reverse; # [4]
$head.display; # [5]
}
[0] Everything after this line is new.
[1] A class for the elements, with two fields; the value [1a] and a pointer to
the next element [1b]. The is rw part isn't necessary in this
version of the program (as we don't change anything after object creation).
[2] A method that prints the value of the current element and the rest of the linked
list, recursiveley (sort of, but not really). The else block gives
a trailing newline when we reach the end of the linked list.
[3] The first element in the linked list.
[4] Build up the enire linked list from the end, adding one element at a time in front of the list (as the new head).
[5] Print the whole linked list, from the head.
Running it gives the same result as before:
$ raku linked-list-linked
1 → 2 → 2 → 4 → 3 → 5
Other possibilites:
But I'll leave it at that.
|
Helper Function For example, f(1,3) = 1, since: Binary representation of 1 = 01 Binary representation of 3 = 11 There is only 1 different bit. Therefore the subroutine should return 1. Note that if one number is longer than the other in binary, the most significant bits of the smaller number are padded (i.e., they are assumed to be zeroes).
Script Output For example, given 2, 3, 4, the output would be 6, since f(2,3) + f(2,4) + f(3,4) = 1 + 2 + 3 = 6 |
I decided to start gently, with the helper function as a separate program, with verbose output to show what is going on:
File: bit-diff
unit sub MAIN (Int $a is copy, $b is copy, :$verbose); # [1]
($a, $b) = ($b, $a) if $b > $a; # [2]
my $a2 = $a.base(2); # [3]
my $length = $a2.chars; # [4]
my $b2 = $b.fmt('%0' ~ $length ~ 'b'); # [5]
my $c2 = ($a +^ $b).fmt('%0' ~ $length ~ 'b'); # [6]
if $verbose
{
say ": $a2 ($a)";
say ": $b2 ($b)";
say ": $c2 -> ", $c2.comb.sum;
}
say $c2.comb.sum; # [7]
[1] Two variables (writeable copies).
[2] The highest value should be first; swap them if necessary.
[3] Convert the largest one to binary.
[4] Get the length of the first binary number.
[5] Convert the second one to binary, zero padded to the same length as the first one.
[6] The «Exclusive Or» operator, written as
+^ in Raku, gives the difference. Note that the operation is
performed on decimal integers, and not on the binary representation. (So
most of the program is redundant, if
we skip the verbose output.)
[7] Print the sum. (comb gives the individual digits, and
sum adds them together.)
See
docs.raku.org/routine/+^
for more information about the Exclusive Or Operator +^.
Another take, that only does the padding if we have requested verbose mode. It avoids swapping the input parameters. Compare them, and see which version you prefer.
File: bit-diff2
unit sub MAIN (Int $a, $b, :$verbose);
my $c = ($a +^ $b);
my $sum = $c.comb.sum;
if $verbose
{
my $length = (max($a, $b)).base(2).chars;
say ": { $a.fmt('%0' ~ $length ~ 'b') } ($a)";
say ": { $b.fmt('%0' ~ $length ~ 'b') } ($b)";
say ": { $c.fmt('%0' ~ $length ~ 'b') } -> $sum";
}
say $sum;
Running them:
$ raku bit-diff2 98 121
1100010 (98)
1111001 (121)
0011011 -> 4
$ raku bit-diff 98 121
1111001 (121)
1100010 (98)
0011011 -> 4
The combinations are easy, with combinations:
> say <2 3 4>.combinations(2);
((2 3) (2 4) (3 4))
> say <1 2 3 4 5>.combinations(2);
((1 2) (1 3) (1 4) (1 5) (2 3) (2 4) (2 5) (3 4) (3 5) (4 5))
See
docs.raku.org/routine/combinations
for more information about combinations.
The final program, with combinations and +^:
unit sub MAIN (*@numbers where @numbers.elems > 1 && all(@numbers) ~~ Int,
:$verbose); # [1]
my $grand-total; # [2]
for @numbers.combinations(2) -> $list # [3]
{
my $sum = bit-diff(|$list); # [4]
say ": $list -> $sum" if $verbose;
$grand-total += $sum; # [5]
}
say $grand-total; # [6]
sub bit-diff (Int $a, Int $b) # [7]
{
return ($a +^ $b).base(2).comb.sum; # [7a]
}
[1] Note the constraints on the array; more than 1 elements and all of them must be integers.
[2] The total.
[3] For all combinations of 2 elements,
[4] • get the sum
[5] • and add it to the total.
[6] Print the total.
[7] Note how simple this helper function turned out.
Running it:
$ raku bit-sum 2 3 4
6
$ raku bit-sum --verbose 2 3 4
: 2 3 -> 1
: 2 4 -> 2
: 3 4 -> 3
6
This looks like a sequence:
$ raku bit-sum 1 2 # -> 2 # +2 # -> 2
$ raku bit-sum 1 2 3 # -> 4 # +2 # -> 0
$ raku bit-sum 1 2 3 4 # -> 11 # +7 # -> 5
$ raku bit-sum 1 2 3 4 5 # -> 18 # +7 # -> 0
$ raku bit-sum 1 2 3 4 5 6 # -> 27 # +9 # -> 2
$ raku bit-sum 1 2 3 4 5 6 7 # -> 36 # +9 # -> 0
$ raku bit-sum 1 2 3 4 5 6 7 8 # -> 55 # +19 # -> 10
$ raku bit-sum 1 2 3 4 5 6 7 8 9 # -> 74 # +19 # -> 0
$ raku bit-sum 1 2 3 4 5 6 7 8 9 10 # -> 95 # +21 # -> 2
$ raku bit-sum 1 2 3 4 5 6 7 8 9 10 11 # -> 116 # +21 # -> 0
$ raku bit-sum 1 2 3 4 5 6 7 8 9 10 11 12 # -> 142 # +26 # -> 5
$ raku bit-sum 1 2 3 4 5 6 7 8 9 10 11 12 13 # -> 168 # +26 # -> 0
$ raku bit-sum 1 2 3 4 5 6 7 8 9 10 11 12 13 14 # -> 196 # +28 # -> 2
$ raku bit-sum 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 # -> 224 # +28 # -> 0
$ raku bit-sum 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 # -> 271 # +47 # -> 19
There is absolutely a pattern in the increment. The increase in the increment is shown at the end of each line. If the «19» (marked with red) had been «10», it would have been easy to describe the rule.
It is tedious to type and compute the inreases, so why not write a program?
File: bit-sum-musing
unit sub MAIN (Int $limit where $limit > 1 = 100, :$verbose);
my $prev-sum = 0;
my $prev-inc = 0;
my $prev-inx = 0;
my @result;
for 2 .. $limit -> $number
{
my @list = 1 .. $number;
my $sum = bit-sum(@list);
my $inc = $sum - $prev-sum; # [1]
my $inx = $inc - $prev-inc;
say ": bit-sum 1..{ $number.fmt("%3d") } -> { $sum.fmt("%3d") } -> \
{ $inc.fmt("%3d") } -> { $inx.fmt("%3d") }" if $verbose;
@result.push: $inx;
$prev-sum = $sum;
$prev-inc = $inc;
$prev-inx = $inx;
}
put @result; # [1]
sub bit-sum (*@numbers where @numbers.elems > 1 && all(@numbers) ~~ Int)
{
my $grand-total;
for @numbers.combinations(2) -> $list
{
my $sum = bit-diff(|$list);
$grand-total += $sum;
}
return $grand-total;
sub bit-diff (Int $a, Int $b)
{
return ($a +^ $b).base(2).comb.sum;
}
}
[1] The increase in the increase.
[2] I have used put so that it prints the entire array.
say will only print the first 100 (or so) items, and that would be a put
off (pun intended).
See
docs.raku.org/routine/put
for more information about put.
Running it:
$ raku bit-sum-musing --verbose 10
: bit-sum 1.. 2 -> 2 -> 2 -> 2
: bit-sum 1.. 3 -> 4 -> 2 -> 0
: bit-sum 1.. 4 -> 11 -> 7 -> 5
: bit-sum 1.. 5 -> 18 -> 7 -> 0
: bit-sum 1.. 6 -> 27 -> 9 -> 2
: bit-sum 1.. 7 -> 36 -> 9 -> 0
: bit-sum 1.. 8 -> 55 -> 19 -> 10
: bit-sum 1.. 9 -> 74 -> 19 -> 0
: bit-sum 1.. 10 -> 95 -> 21 -> 2
2 0 5 0 2 0 10 0 2
Looking good. Let us have a go at a larger number:
$ raku bit-sum-musing 200
2 0 5 0 2 0 10
0 2 0 5 0 2 0 19
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 36
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 19
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 69
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 19
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 36
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 19
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 134
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 19
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 36
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 19
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 69
0 2 0 5 0 2 0 10
I have added newlines to make the pattern (in the last column) stand out. Note that the value is 10 in every other line. (And the first value on the first line is missing, as we need two values to form a combination.)
The program took about 16 seconds on my pc. Running it with «400» as argument took 2 minutes and 20 seconds. Here are the additional values:
$ raku bit-sum-musing 400
...
0 2 0 5 0 2 0 19
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 36
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 19
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 263
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 19
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 36
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 19
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 69
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 19
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 36
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 19
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 134
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 19
The value «10» appear on every second line, and «19» appears on every fourth line. The only value that differ gives this list: 36,69,36,134,36,69,36,263,36,69,36,134.
Every other value is 36, and the rest gives this list: 69,134,69,263,69,134.
Every other value is 69, and the rest gives this list: 134,263,134.
I don' have enough values to go on like this, but let us look at the values we took out: 19, 36 and 69 (and 134 and 263 if we go on) and how to compute them:
19, 36 (19+17), 69 (36+33), 134 (69+65), 263 (134+129)
Not obvious? We can make it more so:
19, 36 (19+19-2), 69 (36+26-3), 134 (69+69-4), 263 (134+134-5)
This works out for the lower values as well:
2,
5 ( 2 + 2 + 1),
10 ( 5 + 5 + 0),
19 ( 10 + 10 - 1),
36 ( 19 + 19 - 2),
69 ( 36 + 26 - 3),
134 ( 69 + 69 - 4),
263 (134 + 134 - 5)
The sequence:
> my $a = ( my $inc = 2, { $_ + $_ + --$inc } ... * );
> say $a[^10]; # -> (2 5 10 19 36 69 134 263 520 1033)
The first value is 2, and I store that in a variable for the ever decreasing increment. («Decreasing increment» doesn't sound quite right though.)
All that remains is to use this sequence in «bit-sum-musing», instead of computing the values. I'll leave that as an exercise for the reader...
What about even numbers only:
$ raku bit-sum 2 4 # -> 2 # +2 # -> 2
$ raku bit-sum 2 4 6 # -> 4 # +2 # -> 0
$ raku bit-sum 2 4 6 8 # -> 11 # +7 # -> 5
$ raku bit-sum 2 4 6 8 10 # -> 18 # +7 # -> 0
$ raku bit-sum 2 4 6 8 27 # -> 27 # +9 # -> 2
...
Or odd numbers:
$ raku bit-sum 1 3 # -> 1 # +1 # -> 1
$ raku bit-sum 1 3 5 # -> 4 # +3 # -> 2
$ raku bit-sum 1 3 5 7 # -> 8 # +5 # -> 2
$ raku bit-sum 1 3 5 7 9 # -> 16 # +9 # -> 4
$ raku bit-sum 1 3 5 7 9 11 # -> 25 # +9 # -> 0
...
Or prime numbers:
$ raku bit-sum 2 3 # -> 1 # +1 # -> 1
$ raku bit-sum 2 3 5 # -> 6 # +5 # -> 4
$ raku bit-sum 2 3 5 7 # -> 10 # +4 # -> -1
$ raku bit-sum 2 3 5 7 11 # -> 18 # +8 # -> 4
$ raku bit-sum 2 3 5 7 11 13 # -> 30 # +12 # -> 4
$ raku bit-sum 2 3 5 7 11 13 17 # -> 46 # +16 # -> 4
$ raku bit-sum 2 3 5 7 11 13 17 19 # -> 61 # +15 # -> -1
$ raku bit-sum 2 3 5 7 11 13 17 19 23 # -> 78 # +16 # -> 1
$ raku bit-sum 2 3 5 7 11 13 17 19 23 29 # -> 103 # +25 # -> 9
...
This is tedious...
Do you have a déjà vu moment now?
It is easy to add support for other sequences than 1..Inf in «bit-sum-musing».
Here are even numbers, odd numbers, prime numbers and the Fibonacci sequence:
unit sub MAIN (Int $limit where $limit > 1 = 100, :$verbose, :$type = "int");
for 2 .. $limit -> $number
{
my @list; # = 1 .. $number;
given $type
{
when "int" { @list = (1 .. Inf)[^$number] }
when "even" { @list = (2, 4 ... Inf)[^$number] }
when "odd" { @list = (1, 3 ... Inf)[^$number] }
when "prime" { @list = ((1 .. Inf).grep: *.is-prime)[^$number] }
when "fib" { @list = (1, 1, * + * ... Inf)[^$number] }
default { die "Unknown type $_" }
}
say ": bit-sum @list[] -> { $sum.fmt("%3d") } -> { $inc.fmt("%3d") } \
-> { $inx.fmt("%3d") }" if $verbose;
Trying it out:
The «even» numbers actually give the same result as the integers:
$ raku bit-sum-musing2 --type=even 200
2 0 5 0 2 0 10
0 2 0 5 0 2 0 19
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 36
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 19
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 69
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 19
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 36
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 19
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 134
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 19
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 36
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 19
0 2 0 5 0 2 0 10
0 2 0 5 0 2 0 69
0 2 0 5 0 2 0 10
The «odd» numbers start from the first position (i.e. the first one isn't missing). The last value is much easier to describe, as it as the decimal value of the binary digits (1,2,4,8,16,32,64,128,245...):
$ raku bit-sum-musing2 --type=odd 201
1 2 1 4 1 2 1 8
1 2 1 4 1 2 1 16
1 2 1 4 1 2 1 8
1 2 1 4 1 2 1 32
1 2 1 4 1 2 1 8
1 2 1 4 1 2 1 16
1 2 1 4 1 2 1 8
1 2 1 4 1 2 1 64
1 2 1 4 1 2 1 8
1 2 1 4 1 2 1 16
1 2 1 4 1 2 1 8
1 2 1 4 1 2 1 32
1 2 1 4 1 2 1 8
1 2 1 4 1 2 1 16
1 2 1 4 1 2 1 8
1 2 1 4 1 2 1 128
1 2 1 4 1 2 1 8
1 2 1 4 1 2 1 16
1 2 1 4 1 2 1 8
1 2 1 4 1 2 1 32
1 2 1 4 1 2 1 8
1 2 1 4 1 2 1 16
1 2 1 4 1 2 1 8
1 2 1 4 1 2 1 64
1 2 1 4 1 2 1
Prime numbers do't give a pattern that I can find:
$ raku bit-sum-musing2 --type=prime 200
1 4 -1 4 4 4 -1 2 8 -2 10 6 -1 0 7 2 2 12 -1 8 -4 8 6 6 1 -2 4 4 9 0 16 6 -3
16 -3 6 -1 0 8 6 4 0 12 -2 -3 14 4 -2 4 12 -8 16 2 28 -6 14 -5 14 12 -4 -5
12 -3 18 -3 6 9 2 4 0 -4 6 9 6 -3 16 5 10 5 -6 0 4 12 -6 12 10 7 -2 -1 10 2
-6 10 6 -3 14 67 -6 13 -8 7 6 10 -6 15 -4 15 -4 9 -4 6 2 -5 10 20 -6 3 12 0
10 -3 2 1 6 17 -2 2 6 14 -14 -1 8 15 12 16 -2 11 14 -3 -4 10 -4 12 4 -3 16
14 -4 -3 4 7 -4 -3 26 -3 0 12 8 -3 0 14 -2 10 10 -8 8 0 10 -3 8 4 110 21 -10
17 -6 -1 -6 14 0 13 2 14 -12 11 6 -3 12 -3 20 0 6 7 -6 12 6 2 4 -6
The Fibonacci numbers are equally obtuse:
$ raku bit-sum-musing2 --type=fib 200
0 4 -1 4 5 2 4 8 7 6 2 16 9 6 24 -2 -3 0 37 20 6 56 -13 -24 51 74 -40 54 -28
12 14 102 -25 -4 75 -16 -24 90 46 62 23 6 48 -2 134 -160 75 118 22 76 -68 10
33 128 11 -50 198 -36 -48 56 257 36 -185 254 -188 138 -283 384 40 -124 301
32 -17 -50 80 52 247 -68 35 228 63 -286 347 248 -205 412 -647 514 135 -172
225 -94 -5 66 155 70 305 228 -25 -406 147 392 45 -98 187 -268 311 -68 221
374 -476 200 780 -530 -53 556 -374 362 -11 350 82 -426 -63 570 -250 -342 912
-36 -590 698 -164 -168 709 298 -600 878 -1109 1036 152 160 280 -298 -60 -326
434 534 121 192 94 -74 20 -412 526 496 -228 314 -547 322 415 -258 824 -1188
1126 246 674 -1612 697 934 -162 224 -80 -622 671 -120 298 -24 859 -564 419
594 -2285 1596 409 456 186 -316 381 -400 844 172 531 46 -360 180 -212 126 38
1592 -1277
And that's it.