laurent_r

These are some answers to the Week 271, Task 2, of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on June 2, 2024 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 2: Sort by 1 Bits

You are given an array of integers, @ints.

Write a script to sort the integers in ascending order by the number of 1 bits in their binary representation. In case more than one integers have the same number of 1 bits then sort them in ascending order.

Example 1

Input: @ints = (0, 1, 2, 3, 4, 5, 6, 7, 8)
Output: (0, 1, 2, 4, 8, 3, 5, 6, 7)

0 = 0 one bits
1 = 1 one bits
2 = 1 one bits
4 = 1 one bits
8 = 1 one bits
3 = 2 one bits
5 = 2 one bits
6 = 2 one bits
7 = 3 one bits

Example 2

Input: @ints = (1024, 512, 256, 128, 64)
Output: (64, 128, 256, 512, 1024)

All integers in the given array have one 1-bits, so just sort them in ascending order.

Sort by 1 Bits in Raku

We first build an auxiliary bit weight subroutine (bit-w), which returns the number of 1's in the binary representation of the input integer. This is done by converting the input integer into its binary representation, using the base routine, splitting this binary representation into individual digits, and computing the sum of these digits.

We then simply sort the input array by bit weight or by value when the bit weights are equal.

sub bit-w($in) {
    # bit weight function: returns number of 1s in the
    # binary representation of the input integer
    return [+] $in.base(2).comb;
}
sub bit-sort (@test) {
    sort { bit-w($^a) cmp bit-w($^b) or $^a cmp $^b }, @test;
}

my @tests = (0, 1, 2, 3, 4, 5, 6, 7, 8), 
            (1024, 512, 256, 128, 64),
            (7, 23, 512, 256, 128, 64);
for @tests -> @test {
    printf "%-20s => ", "@test[]";
    say bit-sort @test;
}

This program displays the following output:

$ raku ./sort-1-bit.raku
0 1 2 3 4 5 6 7 8    => (0 1 2 4 8 3 5 6 7)
1024 512 256 128 64  => (64 128 256 512 1024)
7 23 512 256 128 64  => (64 128 256 512 7 23)

Note that the two subroutines each have only one code line. In fact, the implementation is so simple that we could compact it into a Raku one-liner (shown here over three lines for blog post formatting reasons):

$ raku -e 'my @in = say sort { [+] $^a.Int.base(2).comb
    cmp [+] $^b.Int.base(2).comb or $^a cmp $^b }, 
    @*ARGS'  0 1 2 3 4 5 6 7 8
(0 1 8 4 2 3 5 6 7)

But I would think that the original version with two subroutines is probably clearer.

Sort by 1 Bits in Perl

This is a port to Perl of the above Raku program. The only significant change is the use of a loop to compute the sum of the digits of the binary representation of the input integer.

use strict;
use warnings;
use feature 'say';

sub bit_w {
    # bit weight function: returns number of 1s in the
    # binary representation of the input integer
    my $out = 0;
    $out += $_ for split //, sprintf "%b", shift;
    return $out;
}
sub bit_sort {
    sort { bit_w($a) <=> bit_w($b) or $a <=> $b } @_;
}

my @tests = ( [0, 1, 2, 3, 4, 5, 6, 7, 8], 
              [1024, 512, 256, 128, 64],
              [7, 23, 512, 256, 128, 64] );
for my $test (@tests) {
    printf "%-20s => ", "@$test";
    say join " ", bit_sort @$test;
}

This program displays the following output:

$ perl ./sort-1-bit.pl
0 1 2 3 4 5 6 7 8    => 0 1 2 4 8 3 5 6 7
1024 512 256 128 64  => 64 128 256 512 1024
7 23 512 256 128 64  => 64 128 256 512 7 23

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on June 9, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.