Sorting a Linked List and Summing Binary Bits

THE WEEKLY CHALLENGE – PERL & RAKU #59

TASK #1 › Linked List

Challenge by Ryan Thompson

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:

Method

An odd little task; it seems what we’ll we need to do first is build a proper linked list.

We can input from the command line, with first our pivot value followed by an array. This array in turn will provide the values and positions for our list nodes. Although not strictly necesssary, our life will be a little easier if we gin up a quick node object, a hash holding a value attribute a ‘next’ slot to hold a reference to the next link and a few handy acccessor methods. Likewise if we walk our input array from the back forward we will have everything we need to feed to our constructor already, if we just keep track of the node we previously made.

Once we finish building our list, the last node made is our start node. We can commence walking our list forward from link to link, allocating each node as we arrive to the end of one of two new linked lists; one list for values less than what we will call the locus, the other list for values equal to or greater. Wiring up these new lists in the forward direction is a little trickier but not really, we need to keep track of the last node in each list and insert the ‘next’ reference to the current node we’re walking through.

Once we’re done we need to link the two lists together and we’re done. So to summarize:

1. convert the input commandline array into a linked list
2. walk said list from the beginning and evaluate each node:
   2a. if it is less than the given value, add it to the end of the pre list
   2b. if it is more than or equal to the given value, add it to the end of the post list
3. link the pre list to the post list:
   3a. point the last element of the pre list to the first element of the post
   3b. point the last element of the post list to null

A BUGHUNT ODDESSY, AND ODDITY

When deciding what to do with a given node, to either link it at the end of the list before our locus point or the list after, we first check whether it’s the first entry. If it is, there’s no link to forge, so we don’t try and set one, but we will wish to note that is the first entry of that list, for either list. These two actions were originally coded in as (typically)

$prelist_last->next($node) if defined $prelist_last;
$prelist_first = $node if not defined $prelist_last;

Because both actions, though only tangentially related, hinge on whether in this case $prelist_last (the last Node in the list of Nodes before our locus point) has already been defined, it made sense to tighten things up and use one tertiary operator:

defined $prelist_last ? $prelist_last->next($node) : $prelist_first = $node;

This scans well: either reset the link of the last node or note this is the first node on that linked list for later reference.

It also doesn’t work.

Can't modify non-lvalue subroutine call of &Node::next at line 100.

What is going on here? The logic seems sound but somehow the subroutine is being treated as an lvalue! Using parenthesis, as

defined $prelist_last ? $prelist_last->next($node) : ($prelist_first = $node);

fixed the behavior, suggesting the = is getting grabby and needs to be isolated, and this is in fact the case. As the condional operator holds higher precedence than common assignment, what we’re really writing here is

(defined $prelist_last ? $prelist_last->next($node) : $prelist_first) = $node;

which when after $prelist_last exists (which it usually will, eventually), resolves to:

$prelist_last->next($node) = $node

which isn’t what we wanted at all! So as perlop notes, using assignment within the tertinary operator without parenthesis is fraught with peril.

Usage:
[colincrain:~/PWC]$ perl linkages.pl 4 1 4 3 2 5 2
1 → 3 → 2 → 2 → 4 → 5

use warnings;
use strict;
use feature ":5.26";

## ## ## ## ## MAIN:

## acquire the locus value and the array representation 
## of the linked list
my ($locus, @input) = @ARGV;
my $next = undef;
my $node;

## 1. convert the input commandline array into a linked list
while (scalar @input > 0) {
    my $value =  pop @input;
    $node = new Node($value, $next);
    $next = $node
}
## $node currently points to beginning of the list

my $prelist_first;
my $prelist_last;
my $postlist_first;
my $postlist_last;

while (defined $node) {
    ## 2a. if it is less than the given value, add it to 
    ##     the end of the pre list
    if ($node->value < $locus) {
        defined $prelist_last ? $prelist_last->next($node) 
                              : ($prelist_first = $node);
        $prelist_last = $node;
    }
    ## 2b. if it is more than or equal to the given value
    ##     add it to the end of the post list
    else {
        defined $postlist_last ? $postlist_last->next($node) 
                               : ($postlist_first = $node);
        $postlist_last = $node;
    }

    $node = $node->next;    
} 

## 3. link the pre list to the post list:

## 3a. point the last element of the pre list to 
##     the first element of the post
$prelist_last->next($postlist_first) if (defined $prelist_last);

## 3b. point the last element of the post list to null
$postlist_last->{'next'} = undef;

## ## ## output

## if prelist never got made, start with the postlist
$node = $prelist_first || $postlist_first;
my @output;
while (defined $node) {
    push @output, $node->value;
    $node = $node->next;
}
say join ' → ', @output;


## ## ## ## ## NODE PACKAGE

package Node;

sub new {
    my ($class, $value, $next)  = @_;
    my $self     = { "value"    => $value,
                     "next"     => $next    };
    bless $self, $class;    
    return $self;    
}

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

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

raku solution

In Raku, the idea of objects is integrated with the roots of the language type system, and as such is much more refined than Perl 5. So it makes sense to expand our simple Node (package there, class here) into a set of classes, our original Node and a new LinkedList class that can keep track of the starting node, the last node, and two methods containing the logic for building a list from an array and stringifying output. The challenge logic, of splitting the original list around the locus value, is kept in the body of MAIN, but remains basically the same. One thing is that because the before and after lists are now LinkedList classes, we can switch lists at the decision point rather than control flow, eliminating some duplicated code, and because our accessor methodology has changed the behavior described in the bug hunt odyssey becomes irrelevant, as it actually is what we want now.

[colincrain:~/PWC]$  raku 59-1-linkages.raku 3 1 9 2 8 3 7
1 → 2 → 9 → 8 → 3 → 7

class Node {
    has Int  $.value is rw;
    has Node $.next  is rw;
}

class LinkedList {
    has Node $.first is rw;
    has Node $.last  is rw;
    
    method populate_from_array ( @array ) {
        my $node;
        my $next;
        while @array.elems > 0 {
            $node = Node.new(value => @array.pop.Int);
            $node.next = $next if $next.defined;
            $next = $node;
        }
        $.first = $node;
    }
    
    method arrow_print () {
        my @output;
        my $node = $.first;
        while (defined $node) {
            push @output, $node.value;
            $node = $node.next;
        }
        @output.join(' → ').say;
    }  
}


sub MAIN (Int:D $locus, *@input) {

    ## 1. convert the input commandline array into a linked list
    my $list = LinkedList.new();
    $list.populate_from_array( @input );
    
    my $before = LinkedList.new();
    my $after  = LinkedList.new();    
    my $node   = $list.first;
    
    ## 2a. if it is less than the given value, add it to 
    ##     the end of the before list
    ## 2b. if it is more than or equal to the given value
    ##     add it to the end of the after list
    ## if a sublist isn't started, start it with the node
    while $node.defined {
        my $sublist = $node.value < $locus ?? $before !! $after;
        $sublist.last.defined ?? $sublist.last.next
                              !! $sublist.first       = $node;
        $sublist.last = $node;
        $node = $node.next;
    }
    
    ## 3. link the pre list to the post list:
    ## 3a. point the last element of the pre list to 
    ##     the first element of the post
    ## 3b. point the last element of the post list to null
    $before.last.next = $after.first if defined $before.last;
    $after.last.next  = Nil if defined $after.last;

    # output
    $list.arrow_print();
}

---

---

TASK #2 › Bit Sum

Challenge By Ryan Thompson

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

Method

Another strange task from the mind of Ryan Thompson, or rather, series of tasks. This one almost reads like a best-of compilation of parts of previous weeks, strung together towards some cryptic goal. But that is no mind, and I feel I should say that I really like this puzzle-like “little bit of this, little bit of that” format. In the real world, solving the problem is more often than not an afterthought. Figuring out what the problem really is is the hard part.

In other words, there’s often many people who know how to do what’s required. The real task is figuring out what work needs to be done.

So in this challenge, I see an assortment of diverse small tasks:

1. create pairings of the input array, such that each element
   is paired exactly once with each other element
2. convert two numbers to their binary representations
3. compare the individual corresponding bits between the two numbers and sum the points of difference
4. sum the results from each set of pairings to compute a final tally

The first task is to find sets of combinations of two elements from a larger set of n elements; this is referred to as “n choose 2”. There are n(n-1)/2 such combinations, and two loops, the second restricted by the search space of the first, will efficiently produce the required indexes, which we then use to substitute those array values into the pairs.

We’re going to circle back to the second task, for reasons which will become clear.

The third component of our mission plan harks back to challenge 55-1, “Flip Binary”. In that challenge we XORed individual bits of a larger binary number with 1, which has the result of turning 1s into 0s and 0s into 1s. Well it does turn out that the ^ exclusive-or bitwise operator that we used then will serve our purposes now as well. In comparing bits with ^, if they are the same it yields 0, otherwise 1. Thus we can count the different bits by counting the 1s in the result of the operation. We count the 1s by summing the array produced by applying split // on the the binary representation of the result. In the Flip Binary challenge I rolled up a custom routine to perform this last task, here we’ll do it differently and just import sum() from List::Util.

Which brings us back to the second part of the process. Because the bitwise xor operator works on decimal numbers, we don’t actually need to convert the input to binary before we operate on it. However we will need to convert the result into a binary representation to count the 1s, so to do this in Perl we use

sprintf "%b", $value

The last part, the sum of the results of the pairings, we get by iterating through the pairings and gathering the results as we go.

It’s still unclear why we might want to do this thing we have done. Such is art, as in life.

bughunt Redux

bughunt redux: When I was figuring out the logic and glue for this little series of tasks, I started, as I am often wont, by dummying up an input, in this case

# my @array = @ARGV
my @array = (2, 3, 4);

In complicated systems, it’s nice to know the answer for specific dataset before you start, to help alert you if you’ve gone astray. Well, after a certain amount of doing just that, I arrived at pretty much what we have below. Everything was working, tightened, redone in raku (remarkably terse, but more on that later) and revisited, and I noticed I hadn’t swapped the input back. So I uncommented the commandline input and struck out the dummy.

And it broke.

Argument "^A" isn't numeric in sprintf at 59_2_bitsum.pl line 121.

Wait, what? I switched back: fine. Back again: broken. I looked at the variables, the input array, the contents of the combintion sets. I swapped and the peeking showed the same data. It was baffling. I mean, the whole thing isn’t very complicated. Methodically progresing, I followed the input through I had isolated the weirdness to the ^ operator, which was producing numbers for the dummy data and nothing for identical numbers entered on the commandline. Everything up until that point was identical. I even checked for whitespace, against all logic.

Thinking about perlguts, a number is stored in a scalar as either an int or a double until it needs to be something else, like a string, at which time Perl generates that value and tucks it into the struct. It dawned on me that just because it looked like a 2, at no point previous to this had it ever been used as a number, doing number stuff. It had been an element in an array that printed like a number, then rearranged in combinations and passed around a bit, but never used to count anything or arithmatically valued for its 2-ness.

I mapped the input:

my @input = map {int} @ARGV

and it worked again. The ^ operator wasn’t failing, it was just being given a string and producing unprintable output. Huh. Apparently the operator works on strings too. I felt bad about this oversight until I found this quote from Brian D Foy in Mastering Perl:

“The bitwise operators also work on strings, although I’m not sure why anyone would ever want to do that outside of an Obfuscated Perl contest.”

Further following up in perlop, I found that I was not alone in getting snared by what they refer to as “this somewhat unpredictable behavior”. It seems important and unclear enough that it’s been addressed in the ‘bitwise’ feature, and as of Perl 5.28 the ^ operator, along with its friends and associates, are numeric-only, with new variants ~. |. &. ^. to be used for strings.

For some reason I had been perusing perlsecret the other day (the things we do for fun…) and remembered the ‘venus’ operator 0+ to force numeric context. It’s not really an operator, we’re just adding 0 to whatever, it’s a no-op that makes it a number. Works just fine, so we’ll do that because it’s cool.

sources:

• brian d foy, Mastering Perl, 2nd Edition (O’Reilly, 2014)
• perlop
• perlsecret

PERL 5 SOLUTION:

Usage:
[colincrain:~/PWC]$  perl bit-off-and-chewed.pl 2 3 4
6

use warnings;
use strict;
use feature ":5.26";

use List::Util qw(sum);

## ## ## ## ## MAIN:

my @array = @ARGV;
my @sets = choose_2_sets( @array );

my $sum;
for my $set ( @sets ) {
    $sum += bit_difference($set->[0], $set->[1]);
}

say $sum;


## ## ## ## ## SUBS:

sub bit_difference {    
    return sum( split //, sprintf "%b", 0+$_[0] ^ 0+$_[1] );
}

sub choose_2_sets {
    my @array = @_;
 	my @out;
	for my $i (0..(scalar @array - 1)) {
		for my $j ($i+1..(scalar @array - 1)) {
			push @out, [ $array[$i], $array[$j] ];
		}		
	}
	return @out;   
}

Raku Solution

Implementing the logic flow above in a Raku version is very efficient. Because we get the array routine .combinations the n-choose-2 sub is not necessary, and between the reduction metaoperator and |$array to flatten out the set sublists the bit_difference() routine is streamlined. The behavior of the exclusive-or is defined to coerce its input to Ints, as well. In fact, the @sets variable and bit_difference() routine can just be inlined, and why make another variable for output just to say it? This condensation results in the one-liner:

raku -e 'say [+] (@*ARGS.combinations: 2).map({ ([+^] |$_).base(2).comb.sum });' 2 3 4

This is neat, but isn’t particularly clear, so here it is left broken into basic elements, and you can see how one was rolled into the other:

[colincrain:~/PWC]$  raku 59-2-bit-off-and-chewed.raku 2 3 4
6

sub MAIN ( *@input ) {

    my @sets = @input.combinations: 2;
    my $sum = [+] @sets.map({bit_difference($_)});

    $sum.say;
}

sub bit_difference ($array) {        
    return ([+^] |$array).base(2).comb.sum;
}

With so many rabbit holes, this week has been very interesting exploration indeed.