prolog finding first cousins in family - prolog

Trying to do a prolog question to find first cousins!
/* 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).
cousin1(Child1,Child2) :-
grandparent(Y1,Child1),
grandparent(Y2,Child2),
not(sibling(Child1,Child2)),
Y1=Y2 .
Seems to be working, but is there a way to stop it from returning true if the same child is input?
EDIT: final answer
cousin1(Child1,Child2) :-
parent(Y1,Child1),
parent(Y2,Child2),
sibling(Y1,Y2).

Final answer!
cousin1(Child1,Child2) :-
parent(Y1,Child1),
parent(Y2,Child2),
sibling(Y1,Y2).

Write a .not-self predicate, which returns false if the children are equal. Add that to your cousin predicate.

Related

Convert a list from findall predicate to a string prolog

I am struggling to identify a way to convert a list to string. This list is the output from a findall predicate.
see below my code.
edge(a,b).
edge(a,c).
edge(b,c).
edge(c,d).
edge(c,e).
edge(d,e).
edge(f,g).
edge(g,h).
route(X, Z, []) :- edge(X, Z).
route(X, Z, [Y|T]) :- edge(X, Y), route(Y, Z, T).
allways(X, Y) :- findall(E, (route(X, Y, E), write(E), nl), _).
%allways(X, Y) :- findall(E, (route(X, Y, E), with_output_to(atom(_),maplist(write, E)), nl), _).
%allways(X, Y) :- findall(E, (route(X, Y, E), atomic_list_concat(E,'',A), nl), _),write(A).
my output
?- allways(a,e).
[b,c]
[b,c,d]
[c]
[c,d]
expected output
?- allways(a,e).
bc
bcd
c
cd
I tried different ways to convert the list to string using with_output_to predicate and atomic_list_concat predicate but nothing works.
When you say "string", what do you mean?
There are many predicates for concatenating a list to an atom. In your case atomic_list_concat/2 sounds about right.
Your problem however is in how you wrote the findall, you are capturing the wrong variable.
?- findall(Str, ( route(a, e, E), atomic_list_concat(E, Str) ), Strs),
forall(member(Str, Strs), format("~w~n", [Str])).
or, if you do not need the list at all, do not use findall at all.
?- forall(( route(a, e, E),
atomic_list_concat(E, Str)
),
format("~w~n", [Str])).

How can i calculate a non-weighted graph length for a path that is given

This is the code so far.
next_to(a, b).
next_to(a, c).
next_to(a, f).
next_to(b, c).
next_to(b, d).
next_to(b, e).
next_to(e, f).
next_to(g, h).
joint_with(X,Y):- next_to(X,Y) ;
next_to(Y,X).
show_path(Node, FinishNode, [Node,FinishNode]) :-
joint_with(Node, FinishNode).
show_path(Node, FinishNode, [Node | Restroute]) :-
joint_with(Node, ANode),
show_path(ANode, FinishNode, Restroute).
How can i change show_path to calculate the length aswell (Give explanation how it work's if possible thanks in advance)
According to Willem's advice, I constructed a solution for your problem which is the following:
next_to(a, b).
next_to(a, c).
next_to(a, f).
next_to(b, c).
next_to(b, d).
next_to(b, e).
next_to(e, f).
next_to(g, h).
joint_with(X, Y) :-
( next_to(X, Y)
; next_to(Y, X)
).
show_path(Node, FinishNode, [Node, FinishNode], _) :-
joint_with(Node, FinishNode).
show_path(Node, FinishNode, [Node|Restroute], Counter) :-
joint_with(Node, ANode),
show_path(ANode, FinishNode, Restroute, _),
length([Node|Restroute], Counter),
!.
But if backtracking doesn't finish Counter does not take its value.

How to find blood relatives only in prolog

Using recursion i need to find all blood relatives of any person in the family tree.
My attempt so far has failed.
Here is my code, with my attempt at the bottom
female(helen).
female(debbie).
female(louise).
female(yvonne).
female(belinda).
female(heather).
male(john).
male(andrew).
male(barry).
male(daniel).
male(charles).
parent(helen, debbie).
parent(helen, barry).
parent(helen, louise).
parent(john, debbie).
parent(john, barry).
parent(andrew, louise).
parent(debbie, yvonne).
parent(debbie, daniel).
parent(barry, charles).
parent(barry, belinda).
parent(louise, heather).
mother(X, Y) :-
female(X),
parent(X, Y).
father(X, Y) :-
male(X),
parent(X,Y).
child(X, Y) :-
parent(Y, X).
daughter(X, Y) :-
parent(Y, X),
female(X).
son(X, Y) :-
parent(Y,X),
male(X).
sister(X, Y) :-
female(X),
parent(Q,X),
parent(Q,Y).
brother(X, Y) :-
male(X),
parent(Q,X),
parent(Q,Y).
sibling(X, Y) :-
parent(Q,X),
parent(Q,Y),
X\=Y.
uncle(X, Y) :-
parent(P,Y),
brother(X,P).
aunt(X, Y) :-
parent(P,Y),
sister(X,P).
cousin(C, Cousin):-
parent(Parent,C),
sibling(Parent,AU),
child(Cousin,AU).
%Here is Relative
relative(An, Re):-
An\=Re,
parent(An, Re);
sibling(An, Re).
relative(An, Rela):-
parent(An, Child);
sibling(An, Rela),
relative(Child, Rela),
An\=Rela, C\=Rela.
Sort of works, but gets stuck in an infinite loop at the end.
Thanks.
not sure about 'relatives' (any person bound reachable in a parent/child relation ?), but your definition seems more complex than needed ( do you know what ; does ?).
I tried
relative(An, Re):-
parent(An, Re).
relative(An, Rela):-
parent(An, C),
relative(C, Rela).
that yields
16 ?- forall(relative(X,Y),writeln(X:Y)).
helen:debbie
helen:barry
helen:louise
john:debbie
john:barry
andrew:louise
debbie:yvonne
debbie:daniel
barry:charles
barry:belinda
louise:heather
helen:yvonne
helen:daniel
helen:charles
helen:belinda
helen:heather
john:yvonne
john:daniel
john:charles
john:belinda
andrew:heather
true.
edit I tried another relation, using a generalized parent/2, but still too permissive.
relative(Pers, Re):-
ancestor(Re, Pers) ; sibling(Pers, Re) ; cousin(Pers, Re) ; uncle(Re, Pers) ; aunt(Re, Pers).
ancestor(Anc, Pers) :- parent(Anc, Pers).
ancestor(Anc, Pers) :- parent(Anc, P), ancestor(P, Pers).
Maybe cousin/2 is too permissive also. Here is the graph
I guess that heather should have only luise,helen,andrew as relatives. It's this true ?
edit given latest comment, seems that the definition could be right. I get
24 ?- setln(X,relative(heather,X)).
andrew
barry
belinda
charles
daniel
debbie
helen
louise
yvonne
true.
that is everyone is related to heather apart john.
Here's one way that works, but it will sometimes produce duplicates. Using setof will give the unique collection. I avoided the miscellaneous relations and stuck with descendent or parent.
descendent(A, B) :-
parent(B, A).
descendent(A, B) :-
parent(C, A),
descendent(C, B).
relative(A, B) :-
descendent(B, A).
relative(A, B) :-
descendent(A, B).
relative(A, B) :-
descendent(A, C),
descendent(B, C),
A \= B.
setof(A, relative(heather, A), Relatives).
Relatives = [andrew,barry,belinda,charles,daniel,debbie,helen,louise,yvonne]
If you don't have setof, you can use the findall/3 and sort/2 ISO predicates:
findall(A, relative(heather, A), R), sort(R, Relatives).
Note that the solutions presented so far assume that all of the relatives have unique names. A general case of dealing with relatives with the same first name (and possibly the same last name) you would need to track and compare lineages for differences.

Prolog - Latin Square solution

I am trying to write a program in Prolog to find a Latin Square of size N.
I have this right now:
delete(X, [X|T], T).
delete(X, [H|T], [H|S]) :-
delete(X, T, S).
permutation([], []).
permutation([H|T], R) :-
permutation(T, X),
delete(H, R, X).
latinSqaure([_]).
latinSquare([A,B|T], N) :-
permutation(A,B),
isSafe(A,B),
latinSquare([B|T]).
isSafe([], []).
isSafe([H1|T1], [H2|T2]) :-
H1 =\= H2,
isSafe(T1, T2).
using SWI-Prolog library:
:- module(latin_square, [latin_square/2]).
:- use_module(library(clpfd), [transpose/2]).
latin_square(N, S) :-
numlist(1, N, Row),
length(Rows, N),
maplist(copy_term(Row), Rows),
maplist(permutation, Rows, S),
transpose(S, T),
maplist(valid, T).
valid([X|T]) :-
memberchk(X, T), !, fail.
valid([_|T]) :- valid(T).
valid([_]).
test:
?- aggregate(count,S^latin_square(4,S),C).
C = 576.
edit your code, once corrected removing typos, it's a verifier, not a generator, but (as noted by ssBarBee in a deleted comment), it's flawed by missing test on not adjacent rows.
Here the corrected code
delete(X, [X|T], T).
delete(X, [H|T], [H|S]) :-
delete(X, T, S).
permutation([], []).
permutation([H|T], R):-
permutation(T, X),
delete(H, R, X).
latinSquare([_]).
latinSquare([A,B|T]) :-
permutation(A,B),
isSafe(A,B),
latinSquare([B|T]).
isSafe([], []).
isSafe([H1|T1], [H2|T2]) :-
H1 =\= H2,
isSafe(T1, T2).
and some test
?- latinSquare([[1,2,3],[2,3,1],[3,2,1]]).
false.
?- latinSquare([[1,2,3],[2,3,1],[3,1,2]]).
true .
?- latinSquare([[1,2,3],[2,3,1],[1,2,3]]).
true .
note the last test it's wrong, should give false instead.
Like #CapelliC, I recommend using CLP(FD) constraints for this, which are available in all serious Prolog systems.
In fact, consider using constraints more pervasively, to benefit from constraint propagation.
For example:
:- use_module(library(clpfd)).
latin_square(N, Rows, Vs) :-
length(Rows, N),
maplist(same_length(Rows), Rows),
maplist(all_distinct, Rows),
transpose(Rows, Cols),
maplist(all_distinct, Cols),
append(Rows, Vs),
Vs ins 1..N.
Example, counting all solutions for N = 4:
?- findall(., (latin_square(4,_,Vs),labeling([ff],Vs)), Ls), length(Ls, L).
L = 576,
Ls = [...].
The CLP(FD) version is much faster than the other version.
Notice that it is good practice to separate the core relation from the actual search with labeling/2. This lets you quickly see that the core relation terminates also for larger N:
?- latin_square(20, _, _), false.
false.
Thus, we directly see that this terminates, hence this plus any subsequent search with labeling/2 is guaranteed to find all solutions.
I have better solution, #CapelliC code takes very long time for squares with N length higher than 5.
:- use_module(library(clpfd)).
make_square(0,_,[]) :- !.
make_square(I,N,[Row|Rest]) :-
length(Row,N),
I1 is I - 1,
make_square(I1,N,Rest).
all_different_in_row([]) :- !.
all_different_in_row([Row|Rest]) :-
all_different(Row),
all_different_in_row(Rest).
all_different_in_column(Square) :-
transpose(Square,TSquare),
all_different_in_row(TSquare).
all_different_in_column1([[]|_]) :- !.
all_different_in_column1(Square) :-
maplist(column,Square,Column,Rest),
all_different(Column),
all_different_in_column1(Rest).
latin_square(N,Square) :-
make_square(N,N,Square),
append(Square,AllVars),
AllVars ins 1..N,
all_different_in_row(Square),
all_different_in_column(Square),
labeling([ff],AllVars).

Prolog and ancestor relationship

I have to write a small prolog program which checks if a given person is a ancestor of a second one.
These are the facts and rules:
mother(tim, anna).
mother(anna, fanny).
mother(daniel, fanny).
mother(celine, gertrude).
father(tim, bernd).
father(anna, ephraim).
father(daniel, ephraim).
father(celine, daniel).
parent(X,Y) :- mother(X,Y).
parent(X,Y) :- father(X,Y).
The test if a person is an ancestor of another person is easy:
ancestor(X, Y) :- parent(X, Y).
ancestor(X, Y) :- parent(X, Z), ancestor(Z, Y).
But now I have to write a method ancestor(X,Y,Z) which also prints out the relationship between two persons. It should look like this
?- ancestor(ephraim, tim, X).
false.
?- ancestor(tim, ephraim, X).
X = father(mother(tim)).
And that is the problem: I have no clue how do to this.
You can use an accumulator to adapt #Scott Hunter's solution :
mother(anna, fanny).
mother(daniel, fanny).
mother(celine, gertrude).
father(tim, bernd).
father(anna, ephraim).
father(daniel, ephraim).
father(celine, daniel).
ancestor(X, Y, Z) :- ancestor(X, Y, X, Z).
ancestor(X, Y, Acc, father(Acc)) :- father(X, Y).
ancestor(X, Y, Acc, mother(Acc)) :- mother(X, Y).
ancestor(X, Y, Acc, Result) :-
father(X, Z),
ancestor(Z, Y, father(Acc), Result).
ancestor(X, Y, Acc, Result) :-
mother(X, Z),
ancestor(Z, Y, mother(Acc), Result).
edit : as Scott Hunter showed in his edit, there's no need for an explicit accumulator here, since we can left the inner part of the term unbound easily at each iteration. His solution is therefore better !
A term manipulation alternative to the accumulator tecnique by #Mog:
parent(X, Y, mother(X)) :- mother(X, Y).
parent(X, Y, father(X)) :- father(X, Y).
ancestor(X, Y, R) :-
parent(X, Y, R).
ancestor(X, Y, R) :-
parent(X, Z, P),
ancestor(Z, Y, A),
eldest(A, P, R).
eldest(A, P, R) :-
A =.. [Af, Aa],
( atom(Aa)
-> T = P
; eldest(Aa, P, T)
),
R =.. [Af, T].
To test, I made tim a father: father(ugo, tim).
?- ancestor(tim, ephraim, X).
X = father(mother(tim)) .
?- ancestor(ugo, ephraim, X).
X = father(mother(father(ugo))) .
Simply add a term which tracts what kind of parent is used at each step (edited to get result in proper order):
ancestor(X,Y,father(X)) :- father(X,Y).
ancestor(X,Y,mother(X)) :- mother(X,Y).
ancestor(X,Y,father(Z2)) :- father(Z,Y), ancestor(X,Z,Z2).
ancestor(X,Y,mother(Z2)) :- mother(Z,Y), ancestor(X,Z,Z2).

Resources