我正在尝试以表格P'表兄Qth删除的方式计算堂兄关系。例如,在下面的图片中,
Thomas and Zack are cousins twice removed.
Thomas and Nikolay are second cousins once removed
Thomas and Saul are third cousins zero'th removed
到目前为止,我有一个像这样的代码,找到表兄弟:
ancestor(X,Z):-parent(X,Z).
ancestor(X,Z):-parent(X,Y), ancestor(Y,Z).
cousins(Child1, Child2) :-
ancestor(Y1,Child1),
ancestor(Y1,Child2),
Child1 \= Child2.
我的逻辑只要Child1和Child2共享一个共同的祖先,他们就是堂兄弟。
我遇到的问题是试图找出他们是第一代堂兄弟,第二代堂兄弟,还是第三堂兄弟等,以及他们是否曾被移除,两次移除或三次移除。
关于如何解决这个问题的任何建议或提示都会非常有帮助。
谢谢!
答案 0 :(得分:1)
我认为我做对了。
您需要 CLP(FD)
库来完成这项工作。
只需在程序开头写:- use_module(library(clpfd)).
即可。
cousins_nth_removed/4
前两个参数是代表人物的原子。名。第三个参数(在[1,sup)
中)代表第一个/第二个/第三个/ ... cousins 关系,而第四个参数(在[0,sup)
中)代表第0个/一次/两次/ ......删除关系
cousins_nth_removed(C1, C2, 1, 0) :- % First cousins, zeroth removed dif(C1, C2), dif(P1, P2), % They have different parents parent_child(P1, C1), parent_child(P2, C2), parent_child(GP, P1), % Their parents have the same parent GP parent_child(GP, P2). cousins_nth_removed(C1, C2, N, 0) :- % Nth cousins, zeroth removed N #> 1, dif(C1, C2), children_removed_ancestor(C1, C2, R, R), % They are both R generations away from dif(P1, P2), % their oldest common ancestor parent_child(P1, C1), parent_child(P2, C2), M #= N - 1, % Their parents are N-1th cousins cousins_nth_removed(P1, P2, M, 0). % zeroth removed cousins_nth_removed(C1, C2, N, R) :- % Nth cousins, Rth removed R #> 0, dif(C1, C2), children_removed_ancestor(C1, C2, R1, R2), % R is the difference of the distances R #= abs(R2 - R1), % between each cousin and their oldest S #= R - 1, % common ancestor ( R1 #= R2, % R = 0 -> Zeroth removed, second rule cousins_nth_removed(C1, C2, N, 0) ; R1 #> R2, % C1 is younger than C2 parent_child(P1, C1), % -> C2 is Nth cousin R-1th removed cousins_nth_removed(P1, C2, N, S) % with the parent of C1 ; R1 #< R2, % C2 is younger than C1 parent_child(P2, C2), % -> C1 is Nth cousin R-1th removed cousins_nth_removed(C1, P2, N, S) % with the parent of C2 ).
children_removed_ancestor/4
这个名称并不理想,但这个谓词基本上用于检索两个人与其最老的共同祖先的代沟。
children_removed_ancestor(C1, C2, R1, R2) :-
child_removed_oldest_ancestor(C1, R1, A),
child_removed_oldest_ancestor(C2, R2, A).
child_removed_oldest_ancestor/3
这个谓词检索一个人和他们最老的祖先之间的代沟。
child_removed_oldest_ancestor(C, 0, C) :- % The ancestor of all \+ parent_child(_, C). % They have no parent child_removed_oldest_ancestor(C, N, A) :- N #> 0, parent_child(P, C), M #= N - 1, child_removed_oldest_ancestor(P, M, A).
?- cousins_nth_removed(thomas, zack, N, R). % Your example
N = 1,
R = 2 ;
false.
?- cousins_nth_removed(thomas, nikolay, N, R). % Your example
N = 2,
R = 1 ;
false.
?- cousins_nth_removed(thomas, saul, N, R). % Your example
N = 3,
R = 0 ;
false.
?- cousins_nth_removed(thomas, C, N, R). % All cousins of thomas
C = farah,
N = 1,
R = 0 ;
C = ping,
N = 2,
R = 0 ;
C = william,
N = 3,
R = 0 ;
C = saul,
N = 3,
R = 0 ;
C = sean,
N = R, R = 1 ;
C = steven,
N = R, R = 1 ;
C = zack,
N = 1,
R = 2 ;
C = kyle,
N = 2,
R = 1 ;
C = nikolay,
N = 2,
R = 1 ;
C = wei,
N = 2,
R = 1 ;
false.
?- cousins_nth_removed(C1, C2, 3, 0). % All third cousins zeroth removed
C1 = ping,
C2 = william ;
C1 = ping,
C2 = saul ;
C1 = farah,
C2 = william ;
C1 = farah,
C2 = saul ;
C1 = ignat,
C2 = william ;
C1 = ignat,
C2 = saul ;
C1 = thomas,
C2 = william ;
C1 = thomas,
C2 = saul ;
C1 = william,
C2 = ping ;
C1 = william,
C2 = farah ;
C1 = william,
C2 = ignat ;
C1 = william,
C2 = thomas ;
C1 = saul,
C2 = ping ;
C1 = saul,
C2 = farah ;
C1 = saul,
C2 = ignat ;
C1 = saul,
C2 = thomas ;
false.
:- use_module(library(clpfd)).
parent_child(leila,min).
parent_child(leila,seema).
parent_child(min,ali).
parent_child(min,jesse).
parent_child(min,john).
parent_child(ali,sean).
parent_child(ali,steven).
parent_child(sean,ping).
parent_child(jesse,dallas).
parent_child(jesse,mustafa).
parent_child(dallas,farah).
parent_child(mustafa,ignat).
parent_child(mustafa,thomas).
parent_child(seema,zack).
parent_child(zack,kyle).
parent_child(zack,nikolay).
parent_child(zack,wei).
parent_child(kyle,william).
parent_child(nikolay,saul).
cousins_nth_removed(C1, C2, 1, 0) :-
dif(C1, C2),
dif(P1, P2),
parent_child(P1, C1),
parent_child(P2, C2),
parent_child(GP, P1),
parent_child(GP, P2).
cousins_nth_removed(C1, C2, N, 0) :-
N #> 1,
dif(C1, C2),
children_removed_ancestor(C1, C2, R, R),
dif(P1, P2),
parent_child(P1, C1),
parent_child(P2, C2),
M #= N - 1,
cousins_nth_removed(P1, P2, M, 0).
cousins_nth_removed(C1, C2, N, R) :-
R #> 0,
dif(C1, C2),
children_removed_ancestor(C1, C2, R1, R2),
R #= abs(R2 - R1),
S #= R - 1,
( R1 #= R2,
cousins_nth_removed(C1, C2, N, 0)
; R1 #> R2,
parent_child(P1, C1),
cousins_nth_removed(P1, C2, N, S)
; R1 #< R2,
parent_child(P2, C2),
cousins_nth_removed(C1, P2, N, S)
).
children_removed_ancestor(C1, C2, R1, R2) :-
child_removed_oldest_ancestor(C1, R1, A),
child_removed_oldest_ancestor(C2, R2, A).
child_removed_oldest_ancestor(C, 0, C) :-
\+ parent_child(_, C).
child_removed_oldest_ancestor(C, N, A) :-
N #> 0,
parent_child(P, C),
M #= N - 1,
child_removed_oldest_ancestor(P, M, A).
我现在讨厌家谱树。