RabbitFarm

2022-11-27

The Weekly Challenge 192 (Prolog Solutions)

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

You are given a positive integer, $n. Write a script to find the binary flip.

Solution


bits(N, Bits):-
    bits(N, [], Bits).    
bits(0, Bits, Bits):-!.
bits(N, BitsAccum, Bits):-
    B is N /\ 1,
    N0 is N >> 1,
    bits(N0, [B|BitsAccum], Bits).

bits_reverse(B, RB):-
    Flipped is xor(B, 1),
    number_chars(Flipped, [RB]).

binary_flip(N, NBitsReversed):-
    bits(N, Bits), 
    maplist(bits_reverse, Bits, BitsReversed),
    number_chars(NBitsReversed, ['0','b'|BitsReversed]).

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- binary_flip(5, BinaryFlip).

BinaryFlip = 2

yes
| ?- binary_flip(4, BinaryFlip).

BinaryFlip = 3

yes
| ?- binary_flip(6, BinaryFlip).

BinaryFlip = 1

yes

Notes

I learned a slightly obscure bit (no pun intended!) of information about Prolog's handling of binary numbers this week. If you prepend '0','b' to a list of characters, or the ascii code equivalents to a list of codes, representing binary digits then number_chars/2 (or number_codes/2) will automatically convert to decimal.

The solution to the whole problem is:

Part 2

You are given a list of integers greater than or equal to zero, @list. Write a script to distribute the number so that each members are same. If you succeed then print the total moves otherwise print -1.

Solution


:-dynamic(moves/1).
moves(0).

equal_distribution(ListIntegers, _):-
    length(ListIntegers, L),
    sum_list(ListIntegers, S),
    Average is S / L,
    F is floor(Average),
    C is ceiling(Average),
    F \== C,
    fail.
equal_distribution(ListIntegers, ListEqualDistribution):-
    length(ListIntegers, L),
    sum_list(ListIntegers, S),
    Average is S / L,
    F is floor(Average),
    C is ceiling(Average),
    F == C,
    length(ListEqualDistribution, L),
    equal_distribution(ListIntegers, F, ListEqual),
    delete(ListEqual, F, ListEqualAverageDeleted),
    length(ListEqualAverageDeleted, ListEqualAverageDeletedLength),
    ((ListEqualAverageDeletedLength == 0,
      ListEqualDistribution = ListEqual);
    equal_distribution(ListEqual, ListEqualDistribution)), !.

distribute(Average, [X, Y], [S, T]):-
    X < Average,
    X < Y,
    S is X + 1,
    T is Y - 1,
    moves(Moves),
    succ(Moves, M),
    retract(moves(Moves)),
    asserta(moves(M)).
distribute(Average, [X, Y], [S, T]):-
    X > Average,
    X > Y,
    S is X - 1,
    T is Y + 1,
    moves(Moves),
    succ(Moves, M),
    retract(moves(Moves)),
    asserta(moves(M)).
distribute(Average, [X, Y], [S, T]):-
    ((X == Average; X == Y);
     (X < Average, X > Y)
    ),
    S = X,
    T = Y.    

equal_distribution([A, B|[]], Average, [X, Y|[]]):-
    maplist(distribute(Average),[[A, B]], [[X, Y]]).
equal_distribution(ListIntegers, Average, [X|T]):-
    append([A, B], RestIntegers, ListIntegers),
    maplist(distribute(Average),[[A, B]], [[X, Y]]),
    equal_distribution([Y|RestIntegers], Average, T).

main(ListIntegers, Moves):-
    retract(moves(_)),
    asserta(moves(0)),
    (equal_distribution(ListIntegers, _), moves(Moves), !);
    Moves = -1.

Sample Run


$ gprolog --consult-file prolog/ch-2.p
| ?- main([1, 0, 5], Moves).

Moves = 4

(1 ms) yes
| ?- main([0, 2, 0], Moves).

Moves = -1

yes
| ?- main([0, 3, 0], Moves).

Moves = 2

yes

Notes

The rules that must be followed are:

1) You can only move a value of '1' per move

2) You are only allowed to move a value of '1' to a direct neighbor/adjacent cell.

This code ended up being a little more complex than I had originally thought it would be. At the heart of the solution is what I consider a pretty nice application of maplist/3 to drive the distribution/3, which is the implementation of the given rules.

We need to track the number of moves taken, not just the final resulting list. Rather than track the moves using a variable passed to the various predicates handling the re-distribution it seemed a bit cleaner to me to instead not have so many variables and asserta/1 and retract/1 the updated number of moves.

I generally try and avoid the use of the disjunction (;)/2 with the exception of small cases where to use it would unnaturally increase the amount of code. In this problem there are several such small cases such as whether we set the number of Moves to -1 in the case of an impossible re-distribution or the condition for detecting that we are done re-distributing.

References

Challenge 192

posted at: 19:05 by: Adam Russell | path: /prolog | permanent link to this entry

Flipping to Redistribute

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

You are given a positive integer, $n. Write a script to find the binary flip.

Solution


use v5.36;
sub int2bits{
    my($n) = @_;
    my @bits;
    while($n){
        my $b = $n & 1;
        unshift @bits, $b;
        $n = $n >> 1;
    }
    return @bits
}

sub binary_flip{
    my($n) = @_;
    my @bits = int2bits($n);
    @bits = map {$_^ 1} @bits;
    return oct(q/0b/ . join(q//, @bits));
}

MAIN:{
    say binary_flip(5);
    say binary_flip(4);
    say binary_flip(6);
}

Sample Run


$ perl perl/ch-1.pl
2
3
1

Notes

There was once a time when I was positively terrified of bitwise operations. Anything at that level seemed a bit like magic. Especially spooky were the bitwise algorithms detailed in Hacker's Delight! Anyway, has time has gone on I am a bit more confortable with these sorts of things. Especially when, like this problem, the issues are fairly straightforward.

The code here does the following:

Part 2

You are given a list of integers greater than or equal to zero, @list. Write a script to distribute the number so that each members are same. If you succeed then print the total moves otherwise print -1.

Solution


use v5.36;
use POSIX;

sub equal_distribution{
    my(@integers) = @_;
    my $moves;
    my $average = unpack("%32I*", pack("I*",  @integers)) / @integers; 
    return -1 unless floor($average) ==  ceil($average);
    {
        map{
            my $i = $_;
            if($integers[$i] > $average && $integers[$i] > $integers[$i+1]){$integers[$i]--; $integers[$i+1]++; $moves++}
            if($integers[$i] < $average && $integers[$i] < $integers[$i+1]){$integers[$i]++; $integers[$i+1]--; $moves++}
        } 0 .. @integers - 2;
        redo unless 0 == grep {$average != $_} @integers;
    }
    return $moves;
}

MAIN:{
    say equal_distribution(1, 0, 5);
    say equal_distribution(0, 2, 0);
    say equal_distribution(0, 3, 0);
}

Sample Run


$ perl perl/ch-2.pl
4
-1
2

Notes

The rules that must be followed are:

1) You can only move a value of '1' per move

2) You are only allowed to move a value of '1' to a direct neighbor/adjacent cell.

First we compute the average of the numbers in the list. Provided that the average is a non-decimal (confirmed by comparing floor to ceil) we know we can compute the necessary "distribution".

The re-distribution itself is handled just by following the rules and continuously looping until all values in the list are the same.

References

oct

Challenge 192

posted at: 19:04 by: Adam Russell | path: /perl | permanent link to this entry