I’ve been doing the Perl Weekly
Challenges. The
latest
involved working with a linked list and determining binary differences.

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.

I'm not at all sure what's important about the linked-ness of this
list. We're not living in C-land here; we have reasonably efficient
list-splicing operators. So, and particularly given the absence of a
data structure definition, I just wrote my solution to operate on a
standard list.

```
my @list=(1,4,3,2,5,2);
```

Run through the list and store a classifier for each element, whether
it should be in the first or second part of the output list.

```
my @m;
foreach (0..$#list) {
if ($list[$_] < $k) {
push @m,1;
} else {
push @m,2;
}
}
```

Then for each part, push the qualifying elements of the original list.

```
my @out;
foreach my $mode (1,2) {
push @out,map {$list[$_]} grep {$m[$_]==$mode} 0..$#m;
}
print join(' → ',@out),"\n";
```

It turns out that Perl6 has a nifty primitive for this:

```
my %m=classify { $_ < $k ?? 1 !! 2 }, @list;
my @out;
for 1,2 -> $mode {
@out.append: %m{$mode}.flat;
}
say join(' → ',@out);
```

All right, if I had this problem to do in real life it would be really
nice to discover this `classify`

keyword waiting for me. (And the
related `categorize`

, which does the same sort of thing but allows you
to put things into multiple categories at once.)

But on the other hand maybe having to load all these obscure and
rarely-used bits of code is part of why it's so darn slow.

Helper Function

For this task, you will most likely need a function f(a,b) which
returns the count of different bits of binary representation of a
and b.

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

Your script should accept n positive numbers. Your script should sum
the result of f(a,b) for every pair of numbers given:

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 find that I resent being told *how* to do the problem. But anyway,
here's the wrapper, fairly standard triangular O(n²) stuff:

```
use List::Util qw(max);
my $s=0;
my @list=(2,3,4);
foreach my $i (0..$#list-1) {
foreach my $j ($i+1..$#list) {
$s+=f($list[$i],$list[$j]);
}
}
print "$s\n";
```

and here's the function:

```
sub f {
my @f=@_;
my @g=map {[split '',sprintf('%b',$_)]} @f;
```

So `@g`

is a pair of lists, most-significant-bit first. Then we
lengthen the shorter one.

```
my $r=max(map{scalar @{$_}} @g);
foreach my $i (0..$#g) {
unshift @{$g[$i]},((0) x ($r-scalar @{$g[$i]}));
}
```

Now just count up the differences.

```
my $d=0;
map {$d+=($g[0][$_]==$g[1][$_])?0:1} (0..$r-1);
return $d;
}
```

Perl6, alas, makes this much harder. Having a list of lists turns out
to break all sorts of things, unless you use some magic syntax that I
don't know. Anyway, the outer wrapper is mostly the same.

```
my $s=0;
my @list=(2,3,4);
for 0..@list.end-1 -> $i {
for $i+1..@list.end -> $j {
$s+=f([@list[$i],@list[$j]]);
}
}
say $s;
```

I ended up having to use two separate list variables `@g`

and `@h`

rather than working with `@g[0]`

and `@g[1]`

which ought to be the
representations of the lists. But otherwise the program flow is the
same.

```
sub f (@f) {
my @g=(map {comb /./,sprintf('%b',$_)}, @f[0]).flat;
my @h=(map {comb /./,sprintf('%b',$_)}, @f[1]).flat;
my $r=max(@g.elems,@h.elems);
@g.prepend(0 xx ($r-@g.elems));
@h.prepend(0 xx ($r-@h.elems));
my $d=0;
map {$d+=(@g[$_]==@h[$_])??0!!1}, (0..$r-1);
return $d;
}
```

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.