Perl Weekly Challenge 059: Linked List and Bit Sum

Linked List

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.

We saw Linked List not so long ago, when solving the LRU Cache. Nevertheless, I didn’t reuse my solution, as I previously used a cyclic variant which doesn’t seem to be helpful here.

So, let’s start with a class of list elements. I call them “nodes”. Each node has a value and a link to a next node (undef if there’s none). A node can be disconnected from the next node, or a new node can be attached to it.

package My::Node;

sub new {
    my ($class, $value) = @_;
    bless [ $value, undef ], $class

sub Next { $_[0][1] }

sub value { $_[0][0] }

sub disconnect {
    my ($self) = @_;
    my $next = $self->Next;
    undef $self->[1];
    return $next

sub attach {
    my ($self, $new_next) = @_;
    die "Already attached" if defined $self->Next;

    $self->[1] = $new_next;

I also added two helper methods. One of them follows node links to the last element (the one that doesn’t have a next one), the second one attaches one node to such a last element linked from another node.

sub Last {
    my ($self) = @_;
    my $node = $self;
    $node = $node->Next while $node->Next;
    return $node

sub append {
    my ($self, $new) = @_;
    if (defined $new) {
    } else {
        $_[1] = $self;

With the node class ready, we can proceed to the linked list. The constructor creates a linked list from a given list of values (i.e. it wraps them into My::Node objects and connects them by links). Each list has a head (the node that starts the list) and values (I use capital V to distinguish it from the core function) which extracts the values from the list.

package My::LinkedList;

sub new {
    my ($class, @list) = @_;
    my $top;
    while (@list) {
        my $value = pop @list;
        my $node = 'My::Node'->new($value);
        $node->attach($top) if $top;
        $top = $node;
    bless { head => $top }, $class

sub head {
    my ($self, $head) = @_;
    $self->{head} = $head if @_ > 1;
    return $self->{head}

sub Values {
    my ($self) = @_;
    my $node = $self->head;
    my @values;
    while ($node) {
        push @values, $node->value;
        $node = $node->Next;
    return \@values

So, how should we now implement the partitioning? We’ll prepare two possible new nodes, “head” and “tail”. Walking the list, we’ll then disconnect each node and append it to the head or tail according to the comparison of its value to k. At the end, we’ll just append the tail to the head.

sub partition {
    my ($self, $k) = @_;
    my $node = $self->head;
    my ($head, $tail);
    while ($node) {
        my $next = $node->disconnect;
        $node->append($node->value >= $k ? $tail : $head);
        $node = $next;
    $tail->append($head) if $head && $tail;
    $_[0]{head} = $head || $tail;

So, when working with the sample input, this is how the nodes are distributed to the head and tail.

You can check my test suite at GitHub.

Bit Sum

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

You 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

We’ll start with the helper function. To get the number of different bits, we want to get the number of ones in the result of a xor b, as xor returns 1 when the bits are different:

a   b   a xor b
0   0      0
0   1      1
1   0      1
1   1      0

In Perl, the bitwise xor is written ^.

To count the number of ones in a bit vector, we can use the trick described in unpack. Unfortunately, it doesn’t work directly on the result of $x ^ $y, because it treats it as a string, so we first need to convert it to its binary numeric representation using pack:

sub diff_bits {
    my ($x, $y) = @_;
    return unpack '%32b*', pack 'N', $x ^ $y

To apply this to a list of integers, we need to iterate over all the possible pairs and sum the results:

sub chain_diff_bits {
    my (@list) = @_;
    my $s = 0;
    for my $i (0 .. $#list - 1) {
        for my $j ($i + 1 .. $#list) {
            $s += diff_bits($list[$i], $list[$j]);
    return $s

It seems like we’ve finished the task!

But, our method contains nested loops, which means it’s terribly inefficient. I’ve used a pen and paper to try whether it would be possible to compute the result more quickly, and I’ve found a way.

Imagine the following three numbers as input: 89, 106, and 116. In binary, they are

   89 | 1 1 1 0 1 0 0
  106 | 1 1 0 1 0 1 0
  116 | 1 0 1 1 0 0 1
        0+2+2+2+2+2+2 = 12

Do you see? The difference is always 0 or 2, it can never be 1 (for three numbers). Why is that?

In fact, if we have all the bits at a given position, each of them is either 0 or 1. The number of all differences is the number of zeros times the number of ones.

This leads to the fast solution which, as you might noticed, doesn’t use the helper function at all. In fact, the helper function was a red herring!

We loop over all the positions, and count the number of ones at the given position in binary representations of all the input numbers. The number of zeros can be easily computed as the number of all the numbers minus the number of ones. To get the number of ones, we use the bitwise AND: &.

sub chain_diff_bits_fast {
    my (@list) = @_;
    my $s = 0;
    my $mask = 1;
    for (1 .. 8 * length $list[0]) {
        my $ones = grep $mask & $_, @list;
        $mask <<= 1;
        $s += $ones * (@list - $ones);
    return $s

The $mask starts at 1 and it shifts one bit to the left in each iteration, i.e. it takes the values 1, 2, 4, 8, 16, etc. Using $mask & $_ returns the bit at the given position, grep in scalar context returns the number of true values, i.e. the number of set bits.

Here’s a benchmark for a list of 1000 random integers < 100:

         Rate    old newest
old    4.48/s     --  -100%
newest 1442/s 32115%     --

That’s a huge improvement!

Leave a comment

About E. Choroba

user-pic I blog about Perl.