/*
Prolog Short Course Lesson
       file name; kenshu.txt   2005.2.20
       home; www.d1.dion.ne.jp/~tmhk/yosida.htm

Run this file on AZ-Prolog (Sofnec Co.)
or Sofnec's trial service.

Parents data are rr('entry','f_parent','m_parent'). 
Explanation of following programs; 
" mom " mom of A is X in rr(A,X,_).  
   Input mom(kosihikari)., then norin22 is shown.
" all mom " show all ancestors (only mother side) of A. 'ancestor' is recursively retrieved. 
   Try ancestor(kosihikari)., then norin22norin8aikoku is shown.
" tab " putt space between ancestors. 
   Try ancestor2(kosihikari)., then norin22 norin8 aikoku is shown.
" mom & dad " define both mother and father side. 
   Try ancestor3(kosihikari). It will show pedigree tree though not proper form.
" count " counts the number of generations retrieved (mother side) for proper tree.
   Try ancestor4(kosihikari)., then norin22 1 norin8 2 aikoku 3 is shown. 
   Last number 3 can be used for the positions of ancestors.  
" 1/2 " is for squaring to obtain coefficient inbreeding/parentage. Try ancestor5(kosihikari).
" ancestor & offspring " is for retrieving common ancestors by p_srch 
   for ancestor side and o_srch for offspring side. 
   Try ancestor6(norin22,norin21)., then it will show common ancestors, asahi and aikoku.

This is framework for pedigree tree and coefficient of parentage/inbreeding.
Actually, more program lines to avoid error, draw proper tree, accumulate all paths, etc. are added.
*/
/*   Prolog program is following */
/* mom */
mom(A):-rr(A,X,_),write(X).
/* all mom */
ancestor(A):-rr(A,X,_),write(X),ancestor(X).
/* tab */
ancestor2(A):-rr(A,X,_),write(X),tab(1),ancestor2(X).
/* mon & dad */
ancestor3(A):-parent(A,X),write(X),ancestor3(X).
parent(X,Y):-tab(1),mom(X,Y).
parent(X,Y):-dad(X,Y).
mom(A,X):-rr(A,X,_).
dad(A,X):-rr(A,_,X),nl.
/* count */
ancestor4(A):-rr(A,X,_),write(X),count(N),tab(1),write(N),tab(1),ancestor4(X).
clock(0).
count(N):-clock(M),N is M+1,retract(clock(M)),assert(clock(N)).
/* 1/2 */
ancestor5(A):-rr(A,X,_),write(X),count(N),tab(1),write(N),Y is 0.5 ^ N,tab(1),write(Y),tab(1),ancestor5(X).
/* ancestor & offspring */
ancestor6(X,Y):-not(o_srch(X,Y,[[],[X]])),not(o_srch(Y,X,[[],[Y]])),not(p_srch(X,Y,[X])).
p_srch(X,Y,L):-(rr(X,V,_);rr(X,_,V)),append(L,V,L1),not(o_srch(V,Y,[L1,[V]])),not(p_srch(V,Y,L1)),fail.
o_srch(V,Y,[L1,L2]):-(rr(Y,V,_);rr(Y,_,V)),append(L2,Y,L3),keiro(L1,L3),!,fail.
o_srch(V,Y,[L1,L2]):-(rr(C,V,_);rr(C,_,V)),not(member(C,L1)),append(L2,C,L3),not(o_srch(C,Y,[L1,L3])),fail.
keiro(L1,L2):-write('*  '),l_disp(L1),nl,write('** '),l_disp(L2),nl.
l_disp([]):-!.
l_disp([H|B]):-write(H),write('  '),l_disp(B).
not(X):-X,!,fail.
not(_).
append([],X,[X]).
append([A|X],Y,[A|Z]):-append(X,Y,Z).
/*   Parent data   */
rr('kosihikari','norin22','norin1').
rr('norin22','norin8','norin6').
rr('norin8','aikoku','asahi').
rr('norin6','joshu','kiryoyosi').
rr('norin1','oba','rikuu132').
rr('rikuu132','aikoku','kamenoo').
rr('norin21','asahi','norin1').