RabbitFarm

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