TWC 192: Frosting a cake without flipping the spatula

In which we refine and refactor past the point of recognition:

(  [\+] ( @a X- target )  )».abs.sum

In Raku, Perl, and Rust.

(Still editing)

TWC Task #1 - Binary Flip

Task and Observations

Given a positive Int, flip all the bits.

Some possible approaches:

  1. Binary XOR
  2. Change to bitstring, tr///, change to int.
  3. Change to bitstring, split to list of chars, map with translation table, join, change to int.
  4. Loop while non-zero, examining bottom bit, setting flipped bit in result, bit-shift input and result.

Thoughts:

  • Approach #1 requires calculating what number would be all binary 1's with the same count of binary digits as the input, but is very efficient.
  • Approach #2 is slower but the code is clearer.
  • Approach #3 I would not choose over #2 in any language that has tr///.
  • Approach #4 is fine, but uses explicit loops that I find less clear and less elegant than the others. Might be fastest, though; I have not checked.

Perl

Approach #2:

use v5.36;
sub task1 ($n) {
    return oct '0b' . sprintf('%b', $n) =~ tr/01/10/r;
}

In recent Perl, the tr/// translation accepts the /r modifier, to return a modified copy instead of modifying the original.

Poorly-named oct() does not just translate octal; it looks for other prefixes like 0b or 0x and translates them from binary or hex to decimal.

Raku

Approaches #1 and #2:

# Faster, by about 10x
sub all_ones (UInt $n --> UInt) { ( 1 +< ($n.log2.floor + 1) ) - 1 }
sub fast1    (UInt $n --> UInt) { $n +^ all_ones($n) }

# Clearer:
sub task1    (UInt $n --> UInt) {
    return $n.base(2)
             .trans( <0 1> => <1 0> )
             .parse-base(2);
}

The full file has a bonus test that task1() and fast1() match output over the first 16_384 integers.

Rust

fn flip_bits(n: u32) -> u32 {
    let all_ones = (n + 1).next_power_of_two() - 1;

    return n ^ all_ones;
}

The full file has a bonus test that the first 64 integers match a pattern of jumping-then-falling values.


TWC Task #2 - Equal Distribution

Task

Given a list of non-negative integers, how many moves of surfit-->deficit, one at time until all are equal? Return -1 if equality is not achievable.

Observations

  • If @list.sum is not evenly divisible by @list.elems, no algorithm will succeed, we can return -1 via early exit.

Progressive analysis:

A:  6  3  3  3  3  0  3  3  3  3  0  1  3  3  3  6  5
B:  3  0  0  0  0 -3  0  0  0  0 -3 -2  0  0  0  3  2 @a X- $target
C:  3  3  3  3  3  0  0  0  0  0 -3 -5 -5 -5 -5 -2  0 [\+]
D:  3  3  3  3  3  0  0  0  0  0  3  5  5  5  5  2  0 abs
E:  3  6  9 12 15 15 15 15 15 15 18 23 28 33 38 40 40 [\+] to view

A: The initial array.

  • Clearly, the target level is 3.
    The excess 3 in that first 6 needs to fill in the first zero, 5 cells away, so that will cost 3*5=15 moves.
    The excess 3 in the last 6 moves 5 cells left into the last zero; 3*5=15 moves.
    The excess 2 in the last 5 moves 5 cells left into the one; 2*5=10 moves, so 40 moves total.

  • Cells already holding the target were "neutral" to our calculation. This suggests we should try "redefining the baseline" by removing the target from every cell, making the cells that already held the target become zero, and those with excess change to hold only the excess amount. That means that cells with less than the target will become negative. Would that break our model?

  • We moved some to the right, and some to the left, which feels like frosting a sheet cake, and would require forward and backward passes (loops over the array).
    But, as we learned with electricity, the flow of electrons, and the backwards "flow" of "holes" where each electron has left, are identical in everything but direction (+1/-1 "sign", in our case).

B: Removed 3 from every cell.

  • Raku: @a X- $target
  • Perl: map { $_ - $target } @a

C: Running total of B.

  • Notice all the zeros in the middle of C; they are not just copied down from B, the zeros are showing

, unless we weirdly allowed "negative frosting"

Raku

First attempt, as I explored the problem:

my $target = @a.sum div +@a;
# Ack! when a low value is in the middle, pull from which side?
# Sweep like icing a cake, either back-and-forth, or circularly via modulo.
# make test cases of 1 2 4 8 and 8 4 2 1
# No, cannot modulo, because task disallows.
my @forward  = @a.keys         .rotor(2 => -1);
my @backward = @a.keys.reverse .rotor(2 => -1);
my $count = 0;
my $i = 0;
until @a.all == $target {
    say "\nstart:", @a;
    for @forward -> ( \i, \j ) {
        if @a[i] > ( @a[j] & $target ) {
            @a[i]--;
            @a[j]++;
            $count++;
        }
    }
    say "FWD  :", @a;
    for @backward -> ( \i, \j ) {
        if @a[i] > ( @a[j] & $target ) {
            @a[i]--;
            @a[j]++;
            $count++;
        }
    }
    say "BACK :", @a;
}

Intermediate:

for @a.rotor( 2 => -1 ) {
 my $diff = .[0] - $target;
 .[0]   -= $diff;
 .[1]   += $diff;
 $count += $diff.abs;
}

die @a.raku unless @a.all == $target;

Final:

sub task2 ( @a --> Int ) {
    return -1 if @a.sum !%% +@a;

    my $target = @a.sum div @a.elems;

    my ($count, $mound) = 0, 0;
    for @a -> $a {
        $mound += $a - $target;
        $count += $mound.abs;
    }

    die "Cannot happen: $mound" unless $mound == 0;

    return $count;
}

How does that work?

The $mound is the excess (or deficit) value being pushed from the prior element onto the current element of the array.

Perl

use v5.36;
use List::Util qw<sum0 reductions>;
sub functional ( @a ) {
    my $s = sum0 @a;

    return -1 if $s % @a;
    my $target = $s / @a;

    return sum0 map         { abs $_ }
                reductions  { $a + $b }
                map         { $_ - $target }
                @a;
}
sub task2 ( @a ) {
    return -1 if sum0(@a) % scalar(@a);
    my $target = sum0(@a) / scalar(@a);

    my ($count, $mound) = 0, 0;
    for my $n (@a) {
        $mound += $n - $target;
        $count += abs $mound;
    }

    die "Cannot happen: $mound" unless $mound == 0;

    return $count;
}

A few tricks used here:

  • List::Util::reductions() is the Perl equivalent to Raku's .produce() or "triangular" reduce meta-op.

  • Both task2() and its functional() twin are tested by each test case.


Rust

fn task2 ( a : Vec<i32> ) -> i32 {
    let sum : i32 = a.iter().sum();
    let len : i32 = a.len() as i32;

    if sum % len != 0 {
        return -1;
    }

    let target = sum / len;

    // Raku code: (  [\+] ( @a X- target )  )».abs.sum
    return a.iter()
            .scan(0, |state, &x| { *state += x - target;
                                   Some(*state)          })
            .map(|x| { x.abs() })
            .sum();
}

While this code is generally concise, Rust's scan() feel clumsy to me.
I am not it's only critic.

Leave a comment

About Bruce Gray

user-pic "Util" on IRC and PerlMonks. Frequent speaker on Perl and Raku, but infrequent blogger.