RogerBW's Blog

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;
}