RabbitFarm

2021-07-18

The Weekly Challenge 121 (Prolog Solutions)

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

Part 1

You are given integers 0 <= $m <= 255 and 1 <= $n <= 8. Write a script to invert $n bit from the end of the binary representation of $m and print the decimal representation of the new binary number.

Solution


:-initialization(main).

pad(Bits, Padded):-
    length(Bits, L),
    PadLength is 8 - L,
    length(Padding, PadLength),
    maplist(=(0), Padding),
    append(Padding, Bits, Padded).

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

flip_nth_bit(N, Bits, NthFlipped):-
    N0 is 9 - N,
    N1 is 8 - N,
    nth(N0, Bits, B),
    Flipped is xor(B, 1),
    length(Bits0, N1),
    append(Bits0, [B|T], Bits),
    append(Bits0, [Flipped|T], NthFlipped).

decimal(Bits, Decimal):-
    decimal(Bits, 0, Decimal).
decimal([], Decimal, Decimal).
decimal([H|T], DecimalAccum, Decimal):-
    length([H|T], B),
    D is (H * 2 ** (B - 1)) + DecimalAccum,
    decimal(T, D, Decimal).

main:-
    bits(12, B),
    pad(B, Padded),
    flip_nth_bit(3, Padded, Flipped),
    decimal(Flipped, Decimal),
    write(Decimal), nl,
    halt.

Sample Run


$ gprolog --consult-file prolog/ch-1.p
GNU Prolog 1.4.5 (32 bits)
Compiled Dec  3 2020, 00:37:14 with gcc
By Daniel Diaz
Copyright (C) 1999-2020 Daniel Diaz
| ?- consult('prolog/ch-1.p').
compiling /home/adamcrussell/Projects/perlweeklychallenge-club/challenge-121/adam-russell/prolog/ch-1.p for byte code...
/home/adamcrussell/Projects/perlweeklychallenge-club/challenge-121/adam-russell/prolog/ch-1.p compiled, 41 lines read - 4756 bytes written, 48 ms
8.0

Notes

This re-uses much code from last week. What is different here is flip_nth_bit/3 which finds the Nth bit specified, XORs it, and then sets the updated list.

References

Challenge 121

posted at: 23:35 by: Adam Russell | path: /prolog | permanent link to this entry