# RabbitFarm

### 2021-10-17

#### The Weekly Challenge 134 (Prolog Solutions)

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

## Part 1

Write a script to generate first 5 Pandigital Numbers in base 10.

### Solution

``````
:-initialization(first_5_pandigitals).

pandigital(Pandigitals):-
Digits = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9],
Pandigitals = [A, B, C, D, E, F, G, H, I, J],
fd_domain([A, B, C, D, E, F, G, H, I, J], Digits),
A #= 1,
B #= 0,
fd_labeling(Pandigitals).

first_5_pandigitals:-
setof(P, pandigital(P), Pandigitals),
sort(Pandigitals, [A, B, C, D, E | _ ]),
print_pandigitals([A, B, C, D, E]).

print_pandigitals([]).
print_pandigitals([H|T]):-
maplist(number_codes, H, Codes),
flatten(Codes, DigitCodes),
number_codes(Number, DigitCodes),
write(Number), nl,
print_pandigitals(T).
``````

### Sample Run

``````
\$ gplc prolog/ch-1.p
\$ prolog/ch-1
1023456789
1023456798
1023456879
1023456897
1023456978
``````

### Notes

Rather than recursively iterate over numbers like in the Perl solution I instead use a bit of constraint programming to generate and test a large number of candidates. I then take only the first five as required. A bit of intuition, based on the definition, reduces the number of candidates generated: the first digit will clearly be a 1, the second a 0.

This runs pretty quickly, yet another testimonial to the design and implementation of GNU Prolog's FD solver. On my 2018 Mac Mini it ran to completion in about second. This is much faster than the brute force Perl solution which takes about 20s on the same machine.

## Part 2

You are given 2 positive numbers, \$m and \$n. Write a script to generate multiplication table and display count of distinct terms.

### Solution

``````
:-initialization(main).

table(M, N, K):-
between(1, M, I),
between(1, N, J),
K is I * J.

print_table(M, N, Distinct):-
findall(K, table(M, N, K), Ks),
setof(K, table(M, N, K), Distinct),
print_seperator(M, N),
print_rows(M, N, Ks),
maplist(number_chars, Distinct, DistinctRow),
flatten(DistinctSpaced, DistinctSpacedFlattened),
format("~nDistinct Terms: ~S~n", [DistinctSpacedFlattened]),
length(Distinct, Count),
format("Count: ~d ~n", [Count]).

print_rows(0, _, _).
print_rows(M, N, Products):-
length(Row, N),
append(Rest, Row, Products),
M0 is M - 1,
print_rows(M0, N, Rest),
maplist(number_chars, Row, RowChars),
format(" ~n  ~d | ~S ", [M, CharsSpacedFlattened]).

format("  x | ", _),
N0 is N - 1,
format("~d ", [N]).

print_seperator(_, N):-
format("~n  --+-", _),
print_seperator(N).
print_seperator(0).
print_seperator(N):-
N0 is N - 1,
print_seperator(N0),
format("~a", ['--']).

flatten(C, F),
append(F, [' '], FS),
atom_chars(A, FS),
atom_chars(A, CS).

main:-
print_table(3, 3, _), nl, nl,
print_table(3, 5, _),
halt.
``````

### Sample Run

``````
\$ gplc prolog/ch-2.p
\$ prolog/ch-2
x | 1 2 3
--+-------
1 | 1 2 3
2 | 2 4 6
3 | 3 6 9
Distinct Terms: 1 2 3 4 6 9
Count: 6

x | 1 2 3 4 5
--+-----------
1 | 1 2 3 4 5
2 | 2 4 6 8 10
3 | 3 6 9 12 15
Distinct Terms: 1 2 3 4 5 6 8 9 10 12 15
Count: 11
``````

### Notes

This was an interesting exercise in formatting output in Prolog! As can be seen, the vast majority of the code here is to format the table in the required way. I haven't ever done all that much with `format/2`, but it is quite versatile. As far as formatting output goes it provides a solid set of primitives in the spirit of C's `printf` that allow for us to do whatever we want, albeit with a bit of work.

The actual computation of the value takes no more than the first half dozen or so lines of code in `table/3` and `print_table/3`.

## References

Challenge 134

Pandigital Numbers

GNU Prolog format/2

posted at: 12:55 by: Adam Russell | path: /prolog | permanent link to this entry

### 2021-08-29

#### The Weekly Challenge 127 (Prolog Solutions)

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

## Part 1

You are given two sets with unique numbers. Write a script to figure out if they are disjoint.

### Solution

``````
:-initialization(main).

conflicts(List0, List1):-
member(X, List0),
member(X, List1).

disjoint(List0, List1):-
\+ conflicts(List0, List1).

main:-
((disjoint([1, 2, 5, 3, 4], [4, 6, 7, 8, 9]), write(1)); (write(0))),
nl,
((disjoint([1, 3, 5, 7, 9], [0, 2, 4, 6, 8]), write(1)); (write(0))),
nl,
halt.
``````

### Sample Run

``````
\$ gplc prolog/ch-1.p
\$ prolog/ch-1
0
1
``````

### Notes

The `conflcts/2` predicate establishes whether or not if there is any overlapping elements in the two lists. To establish whether the sets are disjoint `disjoint/2` examines the negation of this result.

Remember, Prolog only backtracks on failure and not success. This fits nicely for what we want. We only care if the lists have any overlap whatsoever. So using backtracking `conflicts/2` will backtrack for all members of List0 until it either succeeds in finding an element that is also in List1 or, if none, fails completely indicating a disjoint set. Since we actually consider the discovery of disjoint sets a success we negate the result with `\+` in `disjoint/2`.

## Part 2

You are given a list of intervals. Write a script to determine conflicts between the intervals.

### Solution

``````
:-initialization(main).

conflicts(Intervals, Conflicts):-
conflicts(Intervals, Conflicts, []).
conflicts([_|[]], Conflicts, ConflictsAccum):-
sort(ConflictsAccum, Conflicts).
conflicts([H|T], Conflicts, ConflictsAccum):-
last(T, Last),
append(Intervals, [Last], T),
append([H], Intervals, CompareIntervals),
comparisons(Last, CompareIntervals, HasConflicts),
append(ConflictsAccum, HasConflicts, ConflictsAccumUpdated),
conflicts(CompareIntervals, Conflicts, ConflictsAccumUpdated).

comparisons(Interval, CompareIntervals, Conflicts):-
comparisons(Interval, CompareIntervals, Conflicts, []).
comparisons(_, [], Conflicts, Conflicts).
comparisons(Interval, [[H0|T0]|T], Conflicts, ConflictsAccum):-
[I|J] = Interval,
I >= H0,
I =< T0,
comparisons([I|J], T, Conflicts, [Interval|ConflictsAccum]).
comparisons([I|J], [_|T], Conflicts, ConflictsAccum):-
comparisons([I|J], T, Conflicts, ConflictsAccum).

main:-
conflicts([[1, 4], [3, 5], [6, 8], [12, 13], [3, 20]], Conflicts0),
write(Conflicts0), nl,
conflicts([[3, 4], [5, 7], [6, 9], [10, 12], [13, 15]], Conflicts1),
write(Conflicts1), nl,
halt.
``````

### Sample Run

``````
\$ gplc prolog/ch-2.p
\$ prolog/ch-2
[[3,5],[3,20]]
[[6,9]]
``````

### Notes

The examples given in the problem statement are with the `[minimum, maximum]` intervals sorted by the maximum value. This makes the problem a bit easier since then we need only check to see if, when working down the sorted list, if the minimum is in one of the other intervals.

This is mostly all handled using recursion which keeps with the nature of the examples in the problem statement. This is fine, and obviously works, but after having worked out the details of finding a solution it seems there is room to make this more, well, logical?

Preferring reasoning over recursion as a principle of Prolog development seems to be reasonable (pun intended!). Here we might, for example, arrange the intervals in Key-Value pairs stored in the Prolog database and make better use of built in backtracking. But even that would include a little extra work as we would need to sort the pairs by value and ultimately the same number of lines of code would be written as shown here, it would just arguably be a bit more Prological.

Sometimes the best solution to a problem is only discovered after working on it for a bit using alternative means!

## References

Challenge 127

Disjoint Sets

posted at: 11:21 by: Adam Russell | path: /prolog | permanent link to this entry

### 2021-08-22

#### The Weekly Challenge 126 (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 print count of numbers from 1 to \$N that don’t contain digit 1.

### Solution

``````
:-initialization(main).

has_1(N):-
number_codes(N, Codes),
memberchk(49, Codes).

count_numbers_without_1(N, Count):-
count_numbers_without_1(N, 0, Count).
count_numbers_without_1(1, Count, Count).
count_numbers_without_1(N, CountAccum, Count):-
\+ has_1(N),
succ(CountAccum, C),
N0 is N - 1,
count_numbers_without_1(N0, C, Count).
count_numbers_without_1(N, CountAccum, Count):-
has_1(N),
N0 is N - 1,
count_numbers_without_1(N0, CountAccum, Count).

main:-
count_numbers_without_1(15, Count0),
write(Count0), nl,
count_numbers_without_1(25, Count1),
write(Count1), nl,
halt.
``````

### Sample Run

``````
\$ gplc prolog/ch-1.p
\$ prolog/ch-1
8
13
``````

### Notes

The `count_numbers_without_1` predicates recurse over the range of numbers and tally the qualifying numbers at each step. `has_1/1` converts the numeral to the list of associated ascii codes and then we see if the ascii code for '1' (49) is present.

## Part 2

You are given a rectangle with points marked with either x or *. Please consider the x as a land mine. Write a script to print a rectangle with numbers and x as in the Minesweeper game.

### Solution

``````
:-initialization(main).

rows(5).
columns(10).
grid([x, '*', '*', '*', x, '*', x, x, x, x,
'*', '*', '*', '*', '*', '*', '*', '*', '*', x,
'*', '*', '*', '*', x, '*', x, '*', x, '*',
'*', '*', '*', x, x, '*', '*', '*', '*', '*',
x, '*', '*', '*', x, '*', '*', '*', '*', x]).

write_grid([H|T]):-
write('\t'),
write_grid([H|T], 0).
write_grid([], _).
write_grid([H|T], Counter):-
columns(Columns),
succ(Counter, C),
M is C mod Columns,
M \== 0,
write(H),
write(' '),
write_grid(T, C).
write_grid([H|T], Counter):-
columns(Columns),
C is Counter + 1,
M is C mod Columns,
M == 0,
write(H),
((rows(Rows),
columns(Columns),
Cells is Rows * Columns,
C \== Cells,
nl,
write('\t'),
write_grid(T, C)
);
(
write_grid(T, C)
)).

minecount(List, MineCount):-
minecount(List, 0, MineCount).
minecount([], MineCount, MineCount).
minecount([H|T], MineCountPartial, MineCount):-
H == x,
MCP is MineCountPartial + 1,
minecount(T, MCP, MineCount).
minecount([H|T], MineCountPartial, MineCount):-
H \== x,
minecount(T, MineCountPartial, MineCount).

columns(Columns),
Columns1 is Columns - 1,
C is Cell + Columns1,
C > 0,
M0 is Cell mod Columns,
M1 is C mod Columns,
((M0 \== 0, M0 \==1, M1 < M0);
(M0 == 0, M1 == Columns1)),

columns(Columns),
Columns1 is Columns - 1,
C is Cell - 1,
C > 0,
M0 is Cell mod Columns,
M1 is C mod Columns,
((M0 \== 0, M0 \==1, M1 < M0);
(M0 == 0, M1 == Columns1)),

columns(Columns),
Columns1 is Columns - 1,
C is Cell - (Columns + 1),
C > 0,
M0 is Cell mod Columns,
M1 is C mod Columns,
((M0 \== 0, M0 \==1, M1 < M0);
(M0 == 0, M1 == Columns1)),

columns(Columns),
Columns1 is Columns - 1,
C is Cell + (Columns + 1),
C > 0,
M0 is Cell mod Columns,
M1 is C mod Columns,
((M1 > M0, M0 \== 0);
(M1 == 0, M0 == Columns1)),

columns(Columns),
Columns1 is Columns - 1,
C is Cell + 1,
C > 0,
M0 is Cell mod Columns,
M1 is C mod Columns,
((M1 > M0, M0 \== 0);
(M1 == 0, M0 == Columns1)),

columns(Columns),
Columns1 is Columns - 1,
C is Cell - Columns1,
M0 is Cell mod Columns,
M1 is C mod Columns,
((M1 > M0, M0 \== 0);
(M1 == 0, M0 == Columns1)),

columns(Columns),
C is Cell - Columns,
C > 0,

columns(Columns),
C is Cell + Columns,
C > 0,

make_grid(Grid, NewGrid):-
make_grid(Grid, 1, [], NewGrid).
make_grid(Grid, Counter, NewGridPartial, NewGrid):-
nth(Counter, Grid, CurrentCell),
CurrentCell \== x,
append(NewGridPartial, [MineCount], NGP),
((rows(Rows),
columns(Columns),
Cells is Rows * Columns,
Counter == Cells,
!,
NewGrid = NGP
);
(succ(Counter, C),
make_grid(Grid, C, NGP, NewGrid))).
make_grid(Grid, Counter, NewGridPartial, NewGrid):-
nth(Counter, Grid, CurrentCell),
CurrentCell == x,
append(NewGridPartial, [CurrentCell], NGP),
((rows(Rows),
columns(Columns),
Cells is Rows * Columns,
Counter == Cells,
!,
NewGrid = NGP
);
(succ(Counter, C),
make_grid(Grid, C, NGP, NewGrid))).

main:-
grid(Grid),
write('Input:'), nl,
write_grid(Grid), nl,
make_grid(Grid, NewGrid),
write('Output:'), nl,
write_grid(NewGrid), nl,
halt.
``````

### Sample Run

``````
\$ gplc prolog/ch-2.p
\$ prolog/ch-2
Input:
x * * * x * x x x x
* * * * * * * * * x
* * * * x * x * x *
* * * x x * * * * *
x * * * x * * * * x
Output:
x 1 0 1 x 2 x x x x
1 1 0 2 2 4 3 5 5 x
0 0 1 3 x 3 x 2 x 2
1 1 1 x x 4 1 2 2 2
x 1 1 3 x 2 0 0 1 x
``````

### Notes

For every cell C which does not contain a mine (x) we need to look at all eight adjacent cells and count the number of mines they contain. The number of mines in the adjacent cells is then set as C's label.

Obtaining the contents of the adjacent cells gets a little tedious. In fact, doing so is the majority of the code here. Care must be taken to make sure that we do not accidentally look for a cell which does not exist or is not actually adjacent. The logic for find the adjacent cells in this way is re-used from a coding challenge I did last year. The Advent of Code 2020 Day 11, in part, had a similar requirement.

After the logic of determining the contents of adjacent cells is worked out, the rest proceeds in a much less complicated way. The contents of all the adjacent cells are examined for mines and the cell labels are set appropriately.

## References

Challenge 126

History of Minesweeper

Advent of Code 2020 Day 11

Prolog Solution: AoC 2020 Day 11 Part 1

posted at: 17:38 by: Adam Russell | path: /prolog | permanent link to this entry

### 2021-08-01

#### The Weekly Challenge 123 (Prolog Solutions)

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

## Part 1

You are given an integer n >= 1. Write a script to find the nth Ugly Number.

### Solution

``````
:-initialization(main).

prime_factors(N, L):-
N > 0,
prime_factors(N, L, 2).
prime_factors(1, [], _):-
!.
prime_factors(N, [F|L], F):-
R is N // F,
N =:= R * F,
!,
prime_factors(R, L, F).
prime_factors(N, L, F):-
next_factor(N, F, NF),
prime_factors(N, L, NF).
next_factor(_, 2, 3):-
!.
next_factor(N, F, NF):-
F * F < N,
!,
NF is F + 2.
next_factor(N, _, N).

ugly(N, UglyNumber):-
ugly(N, 1, 1, _, UglyNumber).
ugly(1, _, _, _, 1).
ugly(N, _, N, UglyNumber, UglyNumber).
ugly(N, X, I, _, UglyNumber):-
prime_factors(X, Factors),
member(Factor, Factors),
(Factor == 2; Factor == 3; Factor == 5),
X0 is X + 1,
I0 is I + 1,
ugly(N, X0, I0, X, UglyNumber).
ugly(N, X, I, UglyNext, UglyNumber):-
X0 is X + 1,
ugly(N, X0, I, UglyNext, UglyNumber).

main:-
ugly(10, UglyNumber),
write(UglyNumber), nl,
halt.
``````

### Sample Run

``````
\$ gplc prolog/ch-1.p
\$ prolog/ch-1
12
``````

### Notes

Here the first N ugly numbers are generated in a pretty routine way. Much of the code is related to computing the prime factors. Once that is out of way the rest of the code seems to be straightforward to follow: recursively counting up each Ugly Number until we reach the Nth one.

## Part 2

You are given coordinates of four points. Write a script to find out if the given four points form a square.

### Solution

``````
:-initialization(main).

dot_product(X0-Y0, X1-Y1, N):-
N0 is X0 * X1,
N is N0 + Y0 * Y1.

swap_key_value([], []).
swap_key_value([A-B|R], [B-A|S]):-
swap_key_value(R, S).

square(Points):-
setof(X, member(X-_, Points),  Xs),
setof(Y, member(_-Y, Points),  Ys),
length(Xs, LXs),
length(Ys, LYs),

keysort(Points, PointsByX),
swap_key_value(Points, Swapped),
keysort(Swapped, PointsByY0),
swap_key_value(PointsByY0, PointsByY),
last(PointsByY, Sx-Sy),
last(PointsByX, Tx-Ty),
nth(1, PointsByY, Ux-Uy),
nth(1, PointsByX, Vx-Vy),
SUx is Sx + Ux,
TVx is Tx + Vx,
SUy is Sy + Uy,
TVy is Ty + Vy,
SUym is Sy - Uy,
TVxm is Tx - Vx,

DVSTx is Sx - Tx,
DVSTy is Sy - Ty,
DVTUx is Tx - Ux,
DVTUy is Ty - Uy,
DVUVx is Ux - Vx,
DVUVy is Uy - Vy,
DVVSx is Vx - Sx,
DVVSy is Vy - Sy,

dot_product(DVSTx-DVSTy, DVTUx-DVTUy, DPSTU),
dot_product(DVTUx-DVTUy, DVUVx-DVUVy, DPTUV),
dot_product(DVUVx-DVUVy, DVVSx-DVVSy, DPUVS),

((LXs == 2, LYs == 2); (SUx == TVx, SUy == TVy, SUym == TVxm, DPSTU == 0, DPTUV == 0, DPUVS == 0)).

main:-
((square([10-20, 20-20, 20-10, 10-10]), write(1)); (write(0))),
nl,
((square([12-24, 16-10, 20-12, 18-16]), write(1)); (write(0))),
nl,
((square([-3-1, 4-2, -(9,-3), -(2,-4)]), write(1)); (write(0))),
nl,
((square([0-0, 2-1, -(3,-1), -(1,-2)]), write(1)); (write(0))),
nl,
halt.
``````

### Sample Run

``````
\$ gplc prolog/ch-2.p
\$ prolog/ch-2
1
0
0
1
``````

### Notes

This is most likely the most tedious Prolog code I have written in a long time! The actual logic of determining if the points determine a square is not so bad:

• Are there only two each of X and Y co-ordinates? Then that is enough to establish that we have a square.
• Otherwise, make sure the side lengths are all equivalent and that the angles between the sides are all 90 degrees.

The tedious part is just all the computation of the distance vectors, the sorting and arranging of the points, and so forth.

The points are represented as pairs. To orient the points they are sorted by X (key) or Y (value). This is both done by the builtin `keysort/2` predicate, with keys and values swapped to facilitate the sorting by value.

In the case of negative co-ordinates we use the alternative `(-)/2` syntax. For example, `-(3,-1)` is used since `3--1` is not valid syntactically.

In the example output we see that the first and last sets of points are both squares. The first is an example of a square with two unique X and Y co-ordinates. The third example is a rhombus and so is a good test to make sure the angles are being checked correctly.

## References

Challenge 123

Rhombus

posted at: 16:58 by: Adam Russell | path: /prolog | permanent link to this entry

### 2021-07-25

#### The Weekly Challenge 122 (Prolog Solutions)

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

## Part 1

You are given a stream of numbers, @N. Write a script to print the average of the stream at every point.

### Solution

``````
:-initialization(main).

moving_average(N):-
moving_average(0, N, 1).
moving_average(Sum, N, I):-
I \== N,
Sum0 is Sum + (I * 10),
Average is Sum0 / I,
write(Average), nl,
I0 is I + 1,
moving_average(Sum0, N, I0).
moving_average(_, N, I):-
I == N.

main:-
moving_average(10),
halt.
``````

### Sample Run

``````
\$ gplc prolog/ch-1.p
\$ prolog/ch-1
10.0
15.0
20.0
25.0
30.0
35.0
40.0
45.0
50.0
``````

### Notes

Typically when one thinks of a stream the idea is of a virtually endless source of data. Or, at least, data which is handled as if this were the case. Here the "stream" is simulated by a generated sequence of numbers. For each recursive call to `moving_average/3` we increase the simulated "stream" by 10 and compute the moving average.

(The idea of a stream in Prolog is fairly specific. My preferred Prolog is Gnu Prolog, which has a very nice write up of the subject.)

## Part 2

You are given a score \$S. You can win basketball points e.g. 1 point, 2 points and 3 points. Write a script to find out the different ways you can score \$S.

### Solution

``````
:-initialization(main).

points --> [].
points --> point, points.
point  --> ; ; ; .

length(Points, Goal),
phrase(points, Points),
sum_list(Points, Goal).

zero_remove([], []).
zero_remove([H|T], [ZR_H|ZR_T]):-
delete(H, 0, ZR_H),
zero_remove(T, ZR_T).

main:-
zero_remove(Points, PointsZR),
sort(PointsZR, PointsZR_Unique),
write(PointsZR_Unique), nl,
halt.
``````

### Sample Run

``````
\$ gplc prolog/ch-2.p
\$ prolog/ch-2
[[1,1,1,1],[1,1,2],[1,2,1],[1,3],[2,1,1],[2,2],[3,1]]
``````

### Notes

This is almost exactly identical to a solution for Challenge 112. The only difference is that I changed the predicate and variable names to match the current problem statement!

## References

Challenge 122

posted at: 18:09 by: Adam Russell | path: /prolog | permanent link to this entry

### 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).

length(Bits, L),

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),
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
| ?- consult('prolog/ch-1.p').
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

### 2021-07-11

#### The Weekly Challenge 120 (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 less than or equal to 255. Write a script to swap the odd positioned bits with the even positioned bits and print the decimal equivalent of the new binary representation.

### Solution

``````
:-initialization(main).

length(Bits, L),

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).

swap([], []).
swap([H0, H1|T], [H1, H0|ST]):-
swap(T, ST).

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(18, B),
decimal(Swapped, 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
33.0
``````

### Notes

Working with bitwise operators in Prolog is something I have done a bit before. This code most notably borrows from a solution to Challenge 079. Here that `set_bit/2` predicate is repurposed as `bits/2` which returns a list of bits for any given number.

The list of bits must be padded (`pad/2`), the bits swapped (`swap/2`), and then the decimal value of the swapped bits calculated (`decimal/2`).

## Part 2

You are given time \$T in the format hh:mm. Write a script to find the smaller angle formed by the hands of an analog clock at a given time.

### Solution

``````
:-initialization(main).

clock_angle(Time, Angle):-
append(H, [58|M], Time),
number_codes(Hour, H),
number_codes(Minutes, M),
A is abs(0.5 * (60 * Hour - 11 * Minutes)),
((A > 180, Angle is 360 - A); Angle = A).

main:-
clock_angle("03:10", Angle),
write(Angle), nl,
halt.
``````

### Sample Run

``````
\$ gprolog --consult-file prolog/ch-2.p
GNU Prolog 1.4.5 (32 bits)
Compiled Dec  3 2020, 00:37:14 with gcc
By Daniel Diaz
35.0
``````

### Notes

`clock_angle/2` starts out by splitting the hh:mm formatted time into the hour and minute parts, by way of append. 58 is the character code for the ':'. Once this is done, and that is perhaps the most prological part of the code, the formula for the angle is applied.

## References

Challenge 120

posted at: 14:37 by: Adam Russell | path: /prolog | permanent link to this entry

### 2021-06-20

#### The Weekly Challenge 117 (Prolog Solutions)

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

## Part 1

You are given text file with rows numbered 1-15 in random order but there is a catch one row in missing in the file.

### Solution

``````
:-initialization(main).

!.
!.
!.
!.
get_code(Stream, NextChar),

at_end_of_stream(Stream).
\+ at_end_of_stream(Stream),
get_code(Stream, Char),
atom_codes(X, Chars),

line_numbers([], []).
line_numbers([N0,_|T], [N1|N]):-
number_atom(N1, N0),
line_numbers(T, N).

missing(Contents, Missing):-
line_numbers(Contents, Numbers),
max_list(Numbers, Max),
min_list(Numbers, Min),
between(Min, Max, X),
\+ member(X, Numbers),
Missing = X.

main:-
close(Stream),
missing(Contents, Missing),
format('Missing: ~d ~N', [Missing]),
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
Missing: 12
``````

### Notes

What interested me the most on this is the majority of the code here is to read in the data file. It's all boilerplate stuff, ordinarily it'd be in some other file of utilities. The work is all done in the seven lines of `missing/2`. Once we have all the line numbers we use `member/2` to determine which one is missing.

As usual there was a second task in this week's challenge but I did not get around to coding up a solution in Prolog. I did get do it in Perl however. Given the nature of that problem my Prolog would have been a fairly close re-implementation of the same algorithm.

Happy Father's Day!

## References

Challenge 117

posted at: 22:53 by: Adam Russell | path: /prolog | permanent link to this entry

### 2021-05-30

#### The Weekly Challenge 114 (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 out the next Palindrome Number higher than the given integer \$N.

### Solution

``````
:-initialization(main).

next_palindrome(N, NextPalindrome):-
current_prolog_flag(max_integer, MAX_INTEGER),
N0 is N + 1,
between(N0, MAX_INTEGER, X),
number_chars(X, C),
reverse(C, R),
number_chars(NR, R),
NR == X,
NextPalindrome = NR.

main:-
next_palindrome(1234, NextPalindrome0),
write(NextPalindrome0), nl,
next_palindrome(999, NextPalindrome1),
write(NextPalindrome1), 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
1331
1001
``````

### Notes

The solution to this task is probably the most intuitive: check numbers starting with `N` and for each one reverse and check.

## Part 2

You are given a positive integer \$N. Write a script to find the next higher integer having the same number of 1 bits in binary representation as \$N.

### Solution

``````
:-initialization(main).

set_bits(N, X):-
set_bits(N, 0, X).
set_bits(0, X, X).
set_bits(N, X_Acc, X):-
B is N /\ 1,
X0 is X_Acc + B,
N0 is N >> 1,
set_bits(N0, X0, X), !.

next_same_bits(N, NextSameBits):-
current_prolog_flag(max_integer, MAX_INTEGER),
set_bits(N, NumberBits),
N0 is N + 1,
between(N0, MAX_INTEGER, X),
set_bits(X, B),
B == NumberBits,
NextSameBits = X.

main:-
next_same_bits(3, NextSameBits0),
write(NextSameBits0), nl,
next_same_bits(12, NextSameBits1),
write(NextSameBits1), nl,
halt.
``````

### Sample Run

``````
\$ gprolog --consult-file prolog/ch-2.p
GNU Prolog 1.4.5 (32 bits)
Compiled Dec  3 2020, 00:37:14 with gcc
By Daniel Diaz
5
17
``````

### Notes

`set_bits/2` is code re-used from Challenge 079. Otherwise, the code is very similar to the solution to the first task.

## References

Challenge 114

posted at: 15:59 by: Adam Russell | path: /prolog | permanent link to this entry

### 2021-05-23

#### The Weekly Challenge 113 (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 and a digit \$D. Write a script to check if \$N can be represented as a sum of positive integers having \$D at least once. If check passes print 1 otherwise 0.

### Solution

``````
:-initialization(main).

contains([], _, []).
contains([H|T], Digit, [N|R]):-
number_chars(H, C),
number_chars(Digit, [D]),
member(D, C),
N = H,
contains(T, Digit, R).
contains([H|T], Digit, Contains):-
number_chars(H, C),
number_chars(Digit, [D]),
\+ member(D, C),
contains(T, Digit, Contains).

represented(N, D):-
findall(X, between(1, N, X), Numbers),
contains(Numbers, D, Contains),
sum_list(Contains, N).

main:-
(((represented(25, 7), write(1)); write(0)), nl),
(((represented(24, 7), write(1)); write(0)), nl),
halt.
``````

### Sample Run

``````
\$ gplc prolog/ch-1.p
\$ prolog/ch-1
0
1
``````

### Notes

This is pretty straightforward Prolog. `contains/3` is a list filter that gets the numbers from the list which contain `Digit`. After that is done we need only check to see if they sum to `N`. If `represented/2` succeeds we print 1 and 0 otherwise.

## Part 2

You are given a Binary Tree. Write a script to replace each node of the tree with the sum of all the remaining nodes.

### Solution

``````
:-dynamic(edge/3).

:-initialization(main).

root(1).
edge(old, 1, 2).
edge(old, 2, 4).
edge(old, 4, 7).
edge(old, 1, 3).
edge(old, 3, 5).
edge(old, 3, 6).

dfs_replace(GraphOld, GraphNew, Vertex):-
dfs_replace(GraphOld, GraphNew, Vertex, _).
dfs_replace(GraphOld, GraphNew, Vertex, VertexPrevious):-
(var(VertexPrevious),
edge(GraphOld, Vertex, VertexNext),
sum_remaining(GraphOld, Vertex, SumRemaining),
dfs_replace(GraphOld, GraphNew, VertexNext, SumRemaining));
sum_remaining(GraphOld, Vertex, SumRemaining),
assertz(edge(GraphNew, VertexPrevious, SumRemaining)),
findall(V, edge(GraphOld, _, V), VerticesOld),
findall(V, edge(GraphNew, _, V), VerticesNew),
length(VerticesOld, VOL),
length(VerticesNew, VNL),
VOL \== VNL,
edge(GraphOld, Vertex, VertexNext),
dfs_replace(GraphOld, GraphNew, VertexNext, SumRemaining).
dfs_replace(GraphOld, GraphNew, _, _):-
findall(V, edge(GraphOld, _, V), VerticesOld),
findall(V, edge(GraphNew, _, V), VerticesNew),
length(VerticesOld, VOL),
length(VerticesNew, VNL),
VOL == VNL.

sum_remaining(GraphOld, Vertex, SumRemaining):-
findall(V, edge(GraphOld, _, V), Vertices),
root(Root),
delete([Root|Vertices], Vertex, RemainingVertices),
sum_list(RemainingVertices, SumRemaining).

main:-
root(Root),
dfs_replace(old, new, Root),
listing(edge/3),
halt.
``````

### Sample Run

``````
\$ gplc prolog/ch-2.p
\$ prolog/ch-2

edge(old, 1, 2).
edge(old, 2, 4).
edge(old, 4, 7).
edge(old, 1, 3).
edge(old, 3, 5).
edge(old, 3, 6).
edge(new, 27, 26).
edge(new, 26, 24).
edge(new, 24, 21).
edge(new, 27, 25).
edge(new, 25, 23).
edge(new, 25, 22).
``````

### Notes

There are several ways to represent trees and graphs in Prolog. Here I chose to store the edges in the Prolog database along with a label containing the graph name. `old` is the original tree and `new` is the one containing the updated values fort eh vertices.

The overal approach is the same as I did for the Perl solution to this problem.

• Perform a Depth First traversal
• As each vertex is visited construct a new edge with the updated values in a new tree
• When the number of updated vertices is the same as the original tree then we are done
• `listing/1` is used to show the original and updated trees

If we did not have the check on the number of updated vertices then `dfs_replace/3` would simply fail when the traversal was complete. As thise code is designed this should instead succeed when complete.

## References

Challenge 112

Depth First Traversal

posted at: 15:32 by: Adam Russell | path: /prolog | permanent link to this entry

### 2021-05-16

#### The Weekly Challenge 112 (Prolog Solutions)

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

## Part 2

You are given \$n steps to climb. Write a script to find out the distinct ways to climb to the top. You are allowed to climb either 1 or 2 steps at a time.

### Solution

``````
:-initialization(main).

steps --> [].
steps --> step, steps.
step  --> ; ; .

sum_steps(Steps, Goal):-
length(Steps, Goal),
phrase(steps, Steps),
sum_list(Steps, Goal).

zero_remove([], []).
zero_remove([H|T], [ZR_H|ZR_T]):-
delete(H, 0, ZR_H),
zero_remove(T, ZR_T).

main:-
findall(Steps, sum_steps(Steps, 4), S),
zero_remove(S, SZR),
sort(SZR, SZR_Unique),
write(SZR_Unique), nl,
halt.
``````

### Sample Run

``````
\$ gprolog --consult-file prolog/ch-2.p
GNU Prolog 1.4.5 (32 bits)
Compiled Dec  3 2020, 00:37:14 with gcc
By Daniel Diaz
[[1,1,1,1],[1,1,2],[1,2,1],[2,1,1],[2,2]]
``````

### Notes

I've been trying to do more with DCGs. This is not the most algorithmically pure use of DCG's but the point here was just to try something new.

Overview of this brute force approach with DCGs:

• Generate all lists of numbers of length `Goal` using digits 0, 1, and 2.
• Keep all those lists that sum to `Goal`
• Remove zeroes from these matching lists
• Remove duplicate lists (using `sort/2`)

## References

Challenge 112

posted at: 18:20 by: Adam Russell | path: /prolog | permanent link to this entry

### 2021-05-02

#### The Weekly Challenge 110 (Prolog Solutions)

The examples used here are from the weekly challenge problem statement and demonstrate the working solution. Also, the challenge statements are given in a Perl context although for Prolog solutions some adjustments are made to account for the differing semantics between the two languages.

## Part 1

You are given a text file. Write a script to display all valid phone numbers in the given text file.

### Solution

``````
:-initialization(main).

test('0044 1148820341').
test('+44 1148820341').
test('44-11-4882-0341').
test('(44) 1148820341').
test('00 1148820341').

phone_number --> prefx,  space, area_exchange_subscriber.
prefx  --> ['('], digit, digit, [')'].
prefx --> ['+'], digit, digit.
prefx --> digit, digit, digit, digit.
space --> [' '].
area_exchange_subscriber --> digit, digit, digit, digit, digit, digit, digit, digit, digit, digit.
digit --> ['0']; ['1']; ['2']; ['3']; ['4']; ['5']; ['6']; ['7']; ['8']; ['9'].

run_tests:-
test(T),
atom_chars(T, C),
phrase(phone_number, C),
write(T), nl.

main:-
run_tests.
``````

### 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
| ?- run_tests.
0044 1148820341

true ? ;
+44 1148820341

true ? ;
(44) 1148820341

true ? ;

(1 ms) no
``````

I skipped anything to do with actually reading the numbers from a file since that doesn’t really add to the interesting part of the problem. Instead the possible phone numbers to test are just stored in the Prolog db.

Testing is done via DCG. The DCG is a bit rotely written, for sure! DCG’s are a bit hard to debug so I thought I’d start out writing things out as obviously as possible and then come back to tighten things up. Coming back to the DCG later on, I thought there was something kind of attractive to the thing, as it is a bit close to the grammar I wrote in the Perl version of the solution. Perhaps someone looking at the Perl grammar would look at this and even not knowing Prolog be able to make perfect sense of it.

## Part 2

You are given a text file. Write a script to transpose the contents of the given file.

### Solution

``````
:-initialization(main).

transpose(Columns, Transposed):-
transpose(Columns, _, Transposed).
transpose([], Transposed, Transposed).
transpose([H|T], TransposedAccum, Transposed):-
transpose_row(H, TransposedAccum, TransposedAccumNew),
reverse(TransposedAccumNew, TransposedAccumNewReversed),
transpose(T, TransposedAccumNewReversed, Transposed).

transpose_row(Row, TransposedAccum, RowTranspose):-
transpose_row(Row, TransposedAccum, [], RowTranspose).
transpose_row([], [], RowTranspose, RowTranspose).
transpose_row([H|T], [HAccum|TAccum], RowTransposeAccum, RowTranspose):-
append(HAccum, H, HAccum0),
flatten(HAccum0, HAccum1),
transpose_row(T, TAccum, [HAccum1 | RowTransposeAccum], RowTranspose).

main:-
transpose([[1,2,3],[4,5,6]], Transposed),
write(Transposed), nl.
``````

### Sample Run

``````
\$ gprolog --consult-file prolog/ch-2.p
GNU Prolog 1.4.5 (32 bits)
Compiled Dec  3 2020, 00:37:14 with gcc
By Daniel Diaz