prolog general rule for finding cousins etc - prolog

The question is to write a general rule to find any level of relative!
cousin(N,Child1,Child2).
So that it is true if Child1 and Child2 are Nth cousins. So
cousin1(Child1,Child2) = cousin(1,Child1,Child2) and
cousin2(Child1,Child2) = cousin(2,Child1,Child2) and so on
for third and fourth and even higher level cousins.
What I have so far:
/* first person is parent of second person */
parent(a, b).
parent(b, f).
parent(a, d).
parent(f, g).
parent(a, k).
parent(f, h).
parent(k, l).
parent(f, i).
parent(k, m).
parent(l, t).
parent(b, e).
sibling(X,Y) :- parent(Z,X), parent(Z,Y), not(X=Y).
grandparent(X, Z) :-
parent(X, Y),
parent(Y, Z).
greatgrandparent(X, Z) :-
parent(X, Y),
parent(Y, P),
parent(P, Z).
cousin1(Child1,Child2) :-
parent(Y1,Child1),
parent(Y2,Child2),
sibling(Y1,Y2).
cousin2(Child1,Child2) :-
greatgrandparent(Z, Child1),
greatgrandparent(Z, Child2),
\+sibling(Child1, Child2),
\+cousin1(Child1, Child2),
Child1 \= Child2.
This returns false regardless of values input, so clearly I have no idea what I am doing PLEASE help!
cousin(N,Child1,Child2) :-
nth0(N, parent(Y1,Child1),Y1),
nth0(N, parent(Y2,Child2),Y2),
cousin1(Y1,Y2).

I tried:
% first person is parent of second person
parent(a, b).
parent(b, f).
parent(a, d).
parent(f, g).
parent(a, k).
parent(f, h).
parent(k, l).
parent(f, i).
parent(k, m).
parent(l, t).
parent(b, e).
sibling(Sib1,Sib2) :- parent(SomeParent,Sib1),
parent(SomeParent,Sib2),
\+ Sib1 = Sib2.
% first person is ancestor of second person
ancestor(Older,Younger,L) :-
parent(Older,Younger),
L is 1.
ancestor(Older,Younger,Level) :-
parent(Older,Child),
ancestor(Child,Younger,L),
Level is L + 1.
%nth_cousin(Level,Cous1,Cous2) :-
% ancestor(Sib1,Cous1,Level),
% ancestor(Sib2,Cous2,Level),
% sibling(Sib1,Sib2).
nth_cousin(Level,Cous1,Cous2) :-
setof((Cous1,Cous2), Sib1^Sib2^(ancestor(Sib1,Cous1,Level),
ancestor(Sib2,Cous2,Level),
sibling(Sib1,Sib2)
),
Cousins),
member((Cous1,Cous2), Cousins),
\+ (Cous2#<Cous1, member((Cous2,Cous1), Cousins)).
Ex.
1 ?- nth_cousin(1,Cous1,Cous2).
Cous1 = e,
Cous2 = l ;
Cous1 = e,
Cous2 = m ;
Cous1 = f,
Cous2 = l ;
Cous1 = f,
Cous2 = m ;
false.
2 ?- nth_cousin(2,Cous1,Cous2).
Cous1 = g,
Cous2 = t ;
Cous1 = h,
Cous2 = t ;
Cous1 = i,
Cous2 = t ;
false.

Related

How to write the predicate Frequest(InList, OutList)?

I need to write the predicate Frequest(InList, OutList) to find the list
OutList of all elements that occur most frequently in the given InList.
Here is my code, help me write more professional and understandable for everyone please.
`counter([], _, 0).
counter([X|T], X, C) :- counter(T, X, C1), C is C1 + 1.
counter([X|T], Y, C) :- X == Y, counter(T, Y, C).
max_count([], , 0).
max_count([E|L], L1, C):-
counter(L1, E, C1),
maxcount(L, L1, C2),
C is max(C1, C2), !.
max_count_el([], , _, []) :- !.
max_count_el([X|L], L1, M, LR) :-
ffff(L, L1, M, LR2),
( counter(L1, X, C),
C == M,
+ member(X, LR2),
append(LR2, [X], LR);
LR = LR2
).
frequentest(L1, L2):-
max_count(L1, L1, R),
max_count_el(L1, L1, R, L2), !.`

Prolog "switch" statement

How can I implement a switch statement equivalent to a nested set of if_s?
Ideally something like (don't mind the syntax):
compatible(X, Y) :-
switch X
a1 -> dif(Y, b2),
a2 -> dif(Y, c2), dif(Y, c3),
_ -> true
working the same way as this one:
compatible(X, Y) :-
if_(X = a1,
dif(Y, b2),
if_(X = a2,
(dif(Y, c2), dif(Y, c3)),
true
)
).
:- module(switch_, []).
:- use_module(library(reif)).
:- multifile goal_expansion/2.
user:goal_expansion(switch_(X, ;(->(H, C), T)), if_(X = H, C, switch_(X, T))).
user:goal_expansion(switch_(X, ->(H, C)), if_(X = H, C, fail)).
user:goal_expansion(switch_(_, true), true).
user:goal_expansion(switch_(_, false), false).
:- use_module(switch_).
likes(A, B) :-
switch_(A, (
john -> B = mary ;
mary -> dif(B, john) ;
true
)).
Example
?- likes(A, B).
A = john,
B = mary ;
A = mary,
dif(B, john) ;
dif(A, mary),
dif(A, john).
?- likes(mary, B).
dif(B, john).
?- likes(john, B).
B = mary.

Avoiding the same answer multiple times in prolog

So I have this undirected graph to traverse, and I should find all the verticies those are connected to a given vertex.
edge(a, b).
edge(b, c).
edge(c, d).
edge(d, e).
edge(e, f).
edge(f, d).
edge(d, g).
edge(g, f).
edge(g, h).
edge(h, i).
edge(i, j).
edge(j, d).
edge(d, k).
edge(l, m).
edge(m, n).
undirectedEdge(X, Y) :- edge(X, Y).
undirectedEdge(X, Y) :- edge(Y, X).
connected(X, Y) :- undirectedEdge(X, Y).
connected(X, Y) :- connected(X, Z), connected(Z, Y), X \= Y.
And once I type connected(a, X). it goes into an infinite loop.
I understand why I have it, but I have no idea how to avoid it, maybe I can find some help here?
Using closure0/3 and setof/3 we get:
connected(A,B) :-
setof(t, closure0(undirectedEdge, A, B), _).
And once I type connected(a, X). it goes into an infinite loop.
The reason this happens is because it is checking a path of the form a &rightarrow; b &rightarrow; a &rightarrow; b &rightarrow; a &rightarrow; b &rightarrow; …. So it keeps "hopping" between two nodes.
You can maintain a list of nodes that the algorithm already visisted, to prevent that like:
connected(X, Y) :-
connected(X, Y, [X]).
connected(X, X, _).
connected(X, Z, L) :-
undirectedEdge(X, Y),
\+ member(Y, L),
connected(Y, Z, [Y|L]).
You can make use of the distinct/1 predicate [swi-doc] to generate distinct answers:
?- distinct(connected(a, X)).
X = a ;
X = b ;
X = c ;
X = d ;
X = e ;
X = f ;
X = g ;
X = h ;
X = i ;
X = j ;
X = k ;
false.

Generate all words of length N and form a list with them in Prolog

Given the letters [a, b, c] generate the list containing all the words of length N, formed out of this letters.
For example:
?- generate(2, L).
should output:
L = [aa, ab, ac, ba, bb, bc, ca, cb, cc].
At first, this seemed like a pretty simple problem, but I've discovered that none of my implementations work.
This is the second implementation, the one that kind of works.
letter(X) :- member(X, [a, b, c]).
generateWord(0, []) :- !.
generateWord(N, [H|T]) :-
letter(H),
NextN is N - 1,
generateWord(NextN, T).
generateAtomicWord(N, Word) :-
generateWord(N, WList),
atomic_list_concat(WList, Word).
maxSolutions(N, R) :- R is N ** 3.
generate(N, CurrentList, ResultList) :-
maxSolutions(N, R),
length(CurrentList, L),
L =:= R,
append(CurrentList, [], ResultList), !.
generate(N, CurrentList, ResultList) :-
generateAtomicWord(N, NewWord),
\+ member(NewWord, CurrentList),
append(CurrentList, [NewWord], NewList),
generate(N, NewList, ResultList).
generate(N, ResultList) :-
generate(N, [], ResultList).
It kind of works because when given N = 3 the program outputs:
L = [aaa, aab, aac, aba, abb, abc, aca, acb, acc|...]
My first implementation is different, but I can't make it work on any case.
letter(X) :- member(X, [a, b, c]).
generateWord(0, []) :- !.
generateWord(N, [H|T]) :-
letter(H),
NextN is N - 1,
generateWord(NextN, T), !.
generateAtomicWord(N, Word) :-
generateWord(N, WList),
atomic_list_concat(WList, Word).
maxSolutions(N, R) :- R is N ** 3.
generate(N, [H]) :- generateAtomicWord(N, H).
generate(N, [H|T]) :-
generate(N, T),
length(T, TailLen),
maxSolutions(N, M),
(TailLen =:= M -> !;
generateAtomicWord(N, H),
\+ member(H, T)).
This one just outputs:
L = [aa]
and when requested for the rest of the solutions it cycles.
The problem must be solved without using predicates such as:
findall, findnsol, bagof, setof, etc...
that find all the solutions.
I've added the tag backtracking because it does resemble a backtracking problem, but I've no idea what a standard implementation might look like in Prolog.
It kind of works because when given N = 3 the program outputs:
L = [aaa, aab, aac, aba, abb, abc, aca, acb, acc|...]
That is not an error, that is the Prolog interpreter that displays the list in a shorter way. If you hit w when it shows the output, it will show the full list. For more information see this answer.
That being said, you make it too hard. You can first make a predicate that will unify a variable with all possible atoms:
letter(X) :- member(X, [a, b, c]).
word(0, []).
word(N, [C|W]) :-
N > 0,
N1 is N-1,
letter(C),
word(N1, W).
Now we can generate all possibilities with findall/3 [swi-doc], and use for example maplist/3 [swi-doc] with atomic_list_concat/2 to convert the list to a single atom:
words(N, L) :-
findall(W, word(N, W), Ws),
maplist(atomic_list_concat, Ws, L).
For example:
?- words(0, L).
L = [''].
?- words(1, L).
L = [a, b, c].
?- words(2, L).
L = [aa, ab, ac, ba, bb, bc, ca, cb, cc].
?- words(3, L).
L = [aaa, aab, aac, aba, abb, abc, aca, acb, acc|...].
We can generate a list of lists ourselves by updating a "difference" list until all possible words are generated:
wordlist(N, L) :-
wordlist(N, [], L, []).
wordlist(0, R, [W|T], T) :-
reverse(R, W),
!.
wordlist(N, C, L, T) :-
N > 0,
N1 is N-1,
wordfold([a,b,c], N1, C, L, T).
wordfold([], _, _, L, L).
wordfold([C|CS], N1, CT, L, T) :-
wordlist(N1, [C|CT], L, L2),
wordfold(CS, N1, CT, L2, T).
For example:
?- wordlist(0, L).
L = [[]].
?- wordlist(1, L).
L = [[a], [b], [c]].
?- wordlist(2, L).
L = [[a, a], [a, b], [a, c], [b, a], [b, b], [b, c], [c, a], [c|...], [...|...]].
You then still need to perform atomic_list_concat on it. I leave that as an exercise.

Prolog append/3 realization with more determinism?

It is folk knowledge that append(X,[Y],Z) finds the last element
Y of the list Z and the remaining list X.
But there is some advantage of having a customized predicate last/3,
namely it can react without leaving a choice point:
?- last([1,2,3],X,Y).
X = 3,
Y = [1,2]
?- append(Y,[X],[1,2,3]).
Y = [1,2],
X = 3 ;
No
Is there a way to realize a different implementation of
append/3 which would also not leave a choice point in the
above example?
P.S.: I am comparing:
/**
* append(L1, L2, L3):
* The predicate succeeds whenever L3 unifies with the concatenation of L1 and L2.
*/
% append(+List, +List, -List)
:- public append/3.
append([], X, X).
append([X|Y], Z, [X|T]) :- append(Y, Z, T).
And (à la Gertjan van Noord):
/**
* last(L, E, R):
* The predicate succeeds with E being the last element of the list L
* and R being the remainder of the list.
*/
% last(+List, -Elem, -List)
:- public last/3.
last([X|Y], Z, T) :- last2(Y, X, Z, T).
% last2(+List, +Elem, -Elem, -List)
:- private last2/4.
last2([], X, X, []).
last2([X|Y], U, Z, [U|T]) :- last2(Y, X, Z, T).
One way to do it is to use foldl/4 with the appropriate help predicate:
swap(A, B, B, A).
list_front_last([X|Xs], F, L) :-
is_list(Xs),
foldl(swap, Xs, F, X, L).
This should be it:
?- list_front_last([a,b,c,d], F, L).
F = [a, b, c],
L = d.
?- list_front_last([], F, L).
false.
?- list_front_last([c], F, L).
F = [],
L = c.
?- Ys = [y|Ys], list_front_last(Ys, F, L).
false.
Try to see if you can leave out the is_list/1 from the definition.
As I posted:
append2(Start, End, Both) :-
% Preventing unwanted choicepoint with append(X, [1], [1]).
is_list(Both),
is_list(End),
!,
append(Start, End, Both),
!.
append2(Start, End, Both) :-
append(Start, End, Both),
% Preventing unwanted choicepoint with append(X, Y, [1]).
(End == [] -> ! ; true).
Result in swi-prolog:
?- append2(Y, [X], [1,2,3]).
Y = [1, 2],
X = 3.

Resources