RabbitFarm
2021-04-25
The Weekly Challenge 109 (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
Write a script to display the first 20 Chowla Numbers.
Solution
:-initialization(main).
print_with_comma([H|[]]):-
write(H), nl.
print_with_comma([H|T]):-
write(H),
write(', '),
print_with_comma(T).
factor(N, Factors):-
S is round(sqrt(N)),
fd_domain(X, 2, S),
R #= N rem X,
R #= 0,
Q #= N // X,
Q #\= X,
fd_labeling([Q, X]),
Factors = [Q, X].
factor(N, Factors):-
S is round(sqrt(N)),
fd_domain(X, 2, S),
R #= N rem X,
R #= 0,
Q #= N // X,
Q #= X,
fd_labeling([Q]),
Factors = [Q].
chowla(ChowlaNumber):-
between(1, 20, N),
findall(F, factor(N, F), Fs),
flatten(Fs, Factors),
sum_list(Factors, ChowlaNumber).
main:-
findall(ChowlaNumber, chowla(ChowlaNumber), ChowlaNumbers),
print_with_comma(ChowlaNumbers).
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
compiling /home/adamcrussell/Projects/perlweeklychallenge-club/challenge-109/adam-russell/prolog/ch-1.p for byte code...
/home/adamcrussell/Projects/perlweeklychallenge-club/challenge-109/adam-russell/prolog/ch-1.p compiled, 41 lines read - 4116 bytes written, 44 ms
0, 0, 0, 2, 0, 5, 0, 6, 3, 7, 0, 15, 0, 9, 8, 14, 0, 20, 0, 21
Notes
Gnu Prolog’s builtin FD solver makes quick work of this problem! To compute a Chowla Number we must compute a number’s unique factors and then take their sum. 1 and the number itself are excluded. So, in the case of primes the Chowla Number is 0. In the case of numbers where a factor is repeated (e.g. 4 = 2 * 2) the repeated factor is only included once.
Part 2
Place the given unique numbers in the square box so that sum of numbers in each box is the same.
Solution
/*
You are given four squares as below with numbers named a,b,c,d,e,f,g.
to place the given unique numbers in the square box so that sum of
numbers in each box is the same.
(1) (3)
+--------------+ +--------------+
? ? ? ?
? a ? ? e ?
? ? (2) ? ? (4)
? +---+------+---+ +---+---------+
? ? ? ? ? ? ? ?
? ? b ? ? d ? ? f ? ?
? ? ? ? ? ? ? ?
? ? ? ? ? ? ? ?
+----------+---+ +---+------+---+ ?
? c ? ? g ?
? ? ? ?
? ? ? ?
+--------------+ +-------------+
*/
:-initialization(main).
print_with_tab([H|[]]):-
write(H), nl.
print_with_tab([H|T]):-
write(H),
write('\t'),
print_with_tab(T).
print_values([]).
print_values([H|T]):-
print_with_tab(H),
print_values(T).
print_solutions(Solutions):-
print_with_tab([a, b, c, d, e, f, g]),
print_values(Solutions).
all_unique(_, []).
all_unique(L, [V|T]) :-
fd_exactly(1, L, V),
all_unique(L, T).
sums_in_squares_naive(Numbers, [A, B, C, D, E, F, G]):-
member(A, Numbers),
member(B, Numbers),
member(C, Numbers),
member(D, Numbers),
member(E, Numbers),
member(F, Numbers),
member(G, Numbers),
\+ (A == B; A == C; A == D; A == E; A == F; A == G),
\+ (B == A; B == C; B == D; B == E; B == F; B == G),
\+ (C == A; C == B; C == D; C == E; C == F; C == G),
\+ (D == A; D == B; D == C; D == E; D == F; D == G),
\+ (E == A; E == B; E == C; E == D; E == F; E == G),
\+ (F == A; F == B; F == C; F == D; F == E; F == G),
\+ (G == A; G == B; G == C; G == D; G == E; G == F),
Box1 is A + B,
Box2 is B + C + D,
Box3 is D + E + F,
Box4 is F + G,
Box1 == Box2,
Box2 == Box3,
Box3 == Box4.
sums_in_squares_fd(Numbers, [A, B, C, D, E, F, G]):-
fd_domain([A, B, C, D, E, F, G], Numbers),
all_unique([A, B, C, D, E, F, G], Numbers),
Box1 = A + B,
Box2 = B + C + D,
Box3 = D + E + F,
Box4 = F + G,
Box1 #= Box2,
Box2 #= Box3,
Box3 #= Box4,
fd_labeling([A, B, C, D, E, F, G]).
main:-
setof(S, sums_in_squares_fd([1,2,3,4,5,6,7], S), Squares),
print_solutions(Squares).
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
Copyright (C) 1999-2020 Daniel Diaz
compiling /home/adamcrussell/Projects/perlweeklychallenge-club/challenge-109/adam-russell/prolog/ch-2.p for byte code...
/home/adamcrussell/Projects/perlweeklychallenge-club/challenge-109/adam-russell/prolog/ch-2.p compiled, 82 lines read - 13210 bytes written, 66 ms
a b c d e f g
3 7 2 1 5 4 6
4 5 3 1 6 2 7
4 7 1 3 2 6 5
5 6 2 3 1 7 4
6 4 1 5 2 3 7
6 4 5 1 2 7 3
7 2 6 1 3 5 4
7 3 2 5 1 4 6
Notes
The Perl solution to this problem used a builtin Prolog available as a Perl module on CPAN. The “naive” version of the solution is effectively the same code as what was used there. I repeated it here to make a couple of comparisons, but that perl module, AI::Prolog, is little better than a toy implementation. Here with Gnu Prolog we can see that with an FD solver this problem can be very quickly computed with a minimum of code.
References
posted at: 16:37 by: Adam Russell | path: /prolog | permanent link to this entry
Chowla Numbers and Numbers in Boxes: The Weekly Challenge 109
The examples used here are from the weekly challenge problem statement and demonstrate the working solution.
Part 1
Write a script to display the first 20 Chowla Numbers.
Solution
use strict;
use warnings;
use constant CHOWLA_COUNT => 20;
sub factor{
my($n) = @_;
my @factors = ();
foreach my $j (2..sqrt($n)){
push @factors, $j if $n % $j == 0;
push @factors, ($n / $j) if $n % $j == 0 && $j ** 2 != $n;
}
return @factors;
}
sub chowla{
my(@factors) = @_;
my $sum = unpack("%32I*", pack("I*", @factors));
}
MAIN:{
my @chowla_numbers;
for my $n (1 .. CHOWLA_COUNT){
push @chowla_numbers, chowla(factor($n));
}
print join(", ", @chowla_numbers) . "\n";
}
Sample Run
$ perl perl/ch-1.pl
0, 0, 0, 2, 0, 5, 0, 6, 3, 7, 0, 15, 0, 9, 8, 14, 0, 20, 0, 21
Notes
This code borrowed quite a bit a previous challenge involving Perfect Numbers. Indeed, the code is nearly identical! After we get the factors there is only the matter of summing them and displaying them.
Part 2
Place the given unique numbers in the square box so that sum of numbers in each box is the same.
Solution
use strict;
use warnings;
##
# You are given four squares as below with numbers named a,b,c,d,e,f,g.
# to place the given unique numbers in the square box so that sum of
# numbers in each box is the same.
# (1) (3)
# +--------------+ +--------------+
# ? ? ? ?
# ? a ? ? e ?
# ? ? (2) ? ? (4)
# ? +---+------+---+ +---+---------+
# ? ? ? ? ? ? ? ?
# ? ? b ? ? d ? ? f ? ?
# ? ? ? ? ? ? ? ?
# ? ? ? ? ? ? ? ?
# +----------+---+ +---+------+---+ ?
# ? c ? ? g ?
# ? ? ? ?
# ? ? ? ?
# +--------------+ +-------------+
##
use AI::Prolog;
my $prolog = do{
local $/;
;
};
$prolog = new AI::Prolog($prolog);
$prolog->query("sums_in_squares([1,2,3,4,5,6,7], Squares).");
my $result;
print join("\t", "a" .. "g") . "\n";
while ($result = $prolog->results()){
print join("\t", @{$result->[2]}) . "\n";
}
__DATA__
member(X,[X|T]).
member(X,[H|T]):- member(X,T).
sums_in_squares(Numbers, [A, B, C, D, E, F, G]):-
member(A, Numbers),
member(B, Numbers),
member(C, Numbers),
member(D, Numbers),
member(E, Numbers),
member(F, Numbers),
member(G, Numbers),
A \= B, A \= C, A \= D, A \= E, A \= F, A \= G,
B \= A, B \= C, B \= D, B \= E, B \= F, B \= G,
C \= A, C \= B, C \= D, C \= E, C \= F, C \= G,
D \= A, D \= B, D \= C, D \= E, D \= F, D \= G,
E \= A, E \= B, E \= C, E \= D, E \= F, E \= G,
F \= A, F \= B, F \= C, F \= D, F \= E, F \= G,
G \= A, G \= B, G \= C, G \= D, G \= E, G \= F,
Box1 is A + B,
Box2 is B + C + D,
Box3 is D + E + F,
Box4 is F + G,
Box1 == Box2,
Box2 == Box3,
Box3 == Box4.
Sample Run
$ perl perl/ch-2.pl
a b c d e f g
3 7 2 1 5 4 6
4 5 3 1 6 2 7
4 7 1 3 2 6 5
5 6 2 3 1 7 4
6 4 1 5 2 3 7
6 4 5 1 2 7 3
7 2 6 1 3 5 4
7 3 2 5 1 4 6
Notes
This sort of problem practically screams out for a Prolog solution! In the interest of keeping with the name, if not the spirit of the weekly challenge, this first part is indeed Perl, albeit using AI::Prolog, a module which offers a pure Perl implementation of a basic Prolog.
I have used AI::Prolog previously and it’s a neat way to take advantage of Prolog within a Perl based solution. The two main downsides are that (1) it is not a full ISO Prolog and (2) it is slow. So very very slow. I suspect, in fact, there is a serious bug in the implementation. Even accounting for the fact that a pure Perl Prolog would be much slower than one written in C, such as Gnu Prolog, the execution time differences are laughably dramatic. I didn’t bother with precise metrics but the code above takes about an hour to run on fairly current hardware (i.e. my 2018 Mac Mini). Essentially the same code run on the same hardware but with Gnu Prolog completes in mere seconds.
Still, this is a nice way to incorporate a bit of Symbolic AI in a Perl code base if there is a small search space. Say, for some simple game logic or a small chat bot.
The pure Prolog solution I did for this uses the same approach, in part, although I also wrote this to take advantage of Gnu Prolog’s FD solver. The FD version of the code completes in about 10ms!
References
posted at: 16:00 by: Adam Russell | path: /perl | permanent link to this entry