RogerBW's Blog

Perl Weekly Challenge 59: linked list and bit sum 12 May 2020

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

  1. Posted by Dave at 11:24am on 12 May 2020

    xor would seem a simpler way to find the bit-differences between two integers. Just need to count the 1's in the binary representation of x^y.

  2. Posted by RogerBW at 11:26am on 12 May 2020

    True, probably faster to bit-count once rather than twice.

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.

Search
Archive
Tags 1920s 1930s 1940s 1950s 1960s 1970s 1980s 1990s 2000s 2010s 3d printing action aeronautics aikakirja anecdote animation anime army astronomy audio audio tech base commerce battletech beer boardgaming book of the week bookmonth chain of command children chronicle church of no redeeming virtues cold war comedy computing contemporary cornish smuggler cosmic encounter coup covid-19 cycling dead of winter doctor who documentary drama driving drone ecchi economics espionage essen 2015 essen 2016 essen 2017 essen 2018 essen 2019 existential risk falklands war fandom fanfic fantasy feminism film firefly first world war flash point flight simulation food garmin drive gazebo geodata gin gurps gurps 101 harpoon historical history horror hugo 2014 hugo 2015 hugo 2016 hugo 2017 hugo 2018 hugo 2019 hugo 2020 hugo-nebula reread humour in brief avoid instrumented life kickstarter learn to play leaving earth linux lovecraftiana mecha men with beards museum mystery naval non-fiction one for the brow opera perl perl weekly challenge photography podcast politics powers prediction privacy project woolsack pyracantha python quantum rail raku ranting raspberry pi reading reading boardgames social real life restaurant reviews romance rpg a day rpgs science fiction scythe second world war security shipwreck simutrans smartphone south atlantic war squaddies stationery steampunk stuarts suburbia superheroes suspense television the resistance thirsty meeples thriller tin soldier torg toys trailers travel type 26 type 31 type 45 vietnam war war wargaming weather wives and sweethearts writing about writing x-wing young adult
Special All book reviews, All film reviews
Produced by aikakirja v0.1