/*     Part 1 Coefficient of parentage and pedigree tree
                                          file name; kinen.txt
Start by  ?-kin., kin2. or  kin3.
kin; Input 2 names.
kin2,3; Input candidate name(s) in this file.
kin3; namae1 x namae2 are obtained. Results are in 'out.txt'.
Parents data; rr('  '). Any place.

original　　　　　　　　　　　by　Sasaaki & Yoshida 1988
kataoya shori sumi                    T.Y 1995.9.18  
kin,kin2,kin3 added                       1995.12.15  
Modified for Windows                      2004.10.18
kin3 > out.txt   added                    2004.11.4 

home; www.d1.dion.ne.jp/~tmhk/yosida.htm
*/
kin:-write('name1 ?'),read(X),write('name2 ?'),read(Y),katao(X,Y),fail.
/* For kin2  */
kin2:-[X,Y]=['kosihikari','yumetukusi'],katao(X,Y),fail.
kin2:-[X,Y]=['kosihikari','hitomebore'],katao(X,Y),fail.
/*  For kin3 computation.  To avoid "out.txt", put % to log lines (No. 3,5,9)     */
kin3:-kotae(0);retract(kotae(V)),fail;
      namae1(X),namae2(Y),kiru(X,L),write(L),kiru(Y,M),write(M),tab(1),katao(X,Y),fail;
      log('out.txt'),
      write('kakka; '),
      nolog,rename('out.txt',[]),log('out.txt'),
      fail;nl,
      namae1(X),namae2(Y),write(X),write(' vs '),write(Y),nl,fail;
      nl,kotae(V),write(V),nl,fail
      ;nolog
      .
/* For kin3  */
namae1('kosihikari').
namae1('hitomebore').
namae2('aikoku').
/* Dummy parents to avoid error */
katao(X,Y):-write(X),nl,write(Y),assert(rr('>>>',X,'dummyx')),
assert(rr('<<<',Y,'dummyy')),[W,Z]=['>>>','<<<'],sta(W,Z).
/* Necessary rr( ) are obtained from r( ) to save time */
r(du1,du2,du3).
rret:-retract(r(X,Y,Z)),fail,!.
oy(A,X):-rr(A,X,_).
oy(A,X):-rr(A,_,X).
oy(X,Y):-fail.
so3(A):-rr(A,Z,W),mae2(A,Z,W),oy(A,X),so3(X).
mae2(A,Z,W):-r(A,Z,W),!,fail;assert(r(A,Z,W)).
/*  Computation  */
sta(X,Y):-so3(X).
sta(X,Y):-so3(Y).
sta(X,Y):-start(X,Y).
sta(X,Y):-rret.
sta(X,Y):-retract(rr('>>>',_,_)),retract(rr('<<<',_,_)).
start(X,Y):-(point(Z)->retract(point(Z));true),assert(point(0)),kinkou(X,Y).
kinkou(X,Y):-not(o_srch(X,Y,1,[[],[X]])),not(o_srch(Y,X,1,[[],[Y]])),
not(p_srch(X,Y,1,[X])),nl,write('Coefficient of Relationship = '),
point(P),nl,Q is P * 4,write(Q),nl,assert(kotae(Q)),write('XXXXXXXXXXXXXXXX'),nl,nl.
p_srch(X,Y,P,L):-(r(X,V,_);r(X,_,V)),A is P * 0.5,append(L,V,L1),
not(o_srch(V,Y,A,[L1,[V]])),not(p_srch(V,Y,A,L1)),fail.
o_srch(V,Y,P,[L1,L2]):-(r(Y,V,_);r(Y,_,V)),A is P * 0.5,append(L2,Y,L3),
retract(point(N)),A1 is N + A,assert(point(A1)),keiro(L1,L3,A),!,fail.
o_srch(V,Y,P,[L1,L2]):-(r(C,V,_);r(C,_,V)),not(member(C,L1)),A is P * 0.5,
append(L2,C,L3),not(o_srch(C,Y,A,[L1,L3])),fail.
keiro(L1,L2,A):-write('*  '),l_disp(L1),nl,write('** '),l_disp(L2),nl,
write(A),write('  x4'),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).
member(A,[A|L]).
member(A,[_|L]):-member(A,L).
/* End of part 1 */
/* Part 2  Pedigree tree drawing
        kakei('name'). Pedigree tree (full).
        kakei3('name'). Pedigree tree (omitting former ones) */
ma('du1').
kakei(A):-d_clear,write('***  Pedigree Tree of  '),write(A),write('    ***'),
c_era,nl,nl,sosen(A). 
kakei3(A):-d_clear,write('***  Pedigree Tree of  '),write(A),write('    ***'),
c_era,nl,nl,sosen3(A),!.
kakei3(A):-ret. 
ret:-retract(ma(X)),fail,!.
oya(X,Y):-tab(1),haha(X,Y),count(N).
oya(X,Y):-titi(X,Y),coun2(N).
oya(X,Y):-coun3(N),fail.
/*  Change 6 for longer generations   */
haha(A,X):-rr(A,X,_),cloc4(K),K<6.
titi(A,X):-rr(A,_,X),cloc4(K),K<6,nl,tab(K*11+1).
cloc4(K):-clock(N),cloc2(M),cloc3(J),K is N+M-J.
sosen(A):-oya(A,X),kiru(X,Y),write(Y),sosen(X).
sosen3(A):-mae(A),oya(A,X),kiru(X,Y),write(Y),sosen3(X).
mae(A):-ma(A),cloc4(K),K<7,write(' - shown   '),coun3(N),!,fail;assert(ma(A)).
kakei2(A):-d_clear,write('***  All ancestors of '),write(A),write('  ***'),
nl,nl,sosen2(A).
oya2(X,Y):-tab(1),haha2(X,Y).
oya2(X,Y):-titi2(X,Y).
haha2(A,X):-rr(A,X,_).
titi2(A,X):-rr(A,_,X),nl.
sosen2(A):-oya2(A,X),write(X),sosen2(X).
kiru(X,Y):-name(X,T),
append2(T,[46,46,46,46,46,46,46,46,46],Z),
Z=[X1,X2,X3,X4,X5,X6,X7,X8,X9,X10|Rest],
W=[X1,X2,X3,X4,X5,X6,X7,X8,X9,X10],name(Y,W).
append2([],X,X).
append2([A|X],Y,[A|Z]):-append2(X,Y,Z).
clock(0).
cloc2(0).
cloc3(0).
coun3(N):-cloc3(M),N is M+1,retract(cloc3(M)),assert(cloc3(N)).
coun2(N):-cloc2(M),N is M+1,retract(cloc2(M)),assert(cloc2(N)).
count(N):-clock(M),N is M+1,retract(clock(M)),assert(clock(N)).
c_era:-retract(clock(N)),assert(clock(0)),retract(cloc2(M)),
assert(cloc2(0)),retract(cloc3(J)),assert(cloc3(0)).
/*    Parents data following   */