/*
漢字データ使用版家系分析用Prologプログラム
ファイル名は“imokin3.txt”
ホームは“d1.dion.ne.jp/~tmhk/yosida.htm”
他殖作物（いも，いちご等）用
動物も可
近交係数計算はinbの次に品種名
子の近交係数計算はkinの次に両親名
このファイル中のkin3に予め候補名を入れておけばダイアレル計算を．out.txtへ出力も
家系図作成はkakeiか同3(品種名)．後者は一度出たのは省力
総祖先数，除共通，世代数の計測はzenbu，同2，sedai（品種名）．最後表示の数
両親データはrr(後ろにあり)の形で追加．場所はどこでも可．品種名以外は半角入力する．
*/
/*
第１部近交係数の計算
*/
inb:-write('name ?'),read(Z),rr(Z,X,Y),katao(X,Y),fail.
kin:-write('name1 ?'),read(X),write('name2 ?'),read(Y),katao(X,Y),fail.
/*
kin3
out出力避けるにはlog部分３行(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
      .
/*
ダミーの架空両親追加．コレしないとうまくいかない
*/
katao(X,Y):-nl,write(X),nl,write(Y),assert(rr('>>>',X,'dummyx')),
assert(rr('<<<',Y,'dummyy')),
[W,Z]=['>>>','<<<'],sta(W,Z).
/*
計算時間節約のためrr() から必要なr()を抽出
*/
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)).
/*
計算
共通祖先の近交係数値をkitiから読む
自殖用はこれをすべて１としている
*/
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 Inbreeding =  (first 0 not included)'),
point(P),nl,Q is P *2,write(Q),write(' + '),wa(Q),nl.
waa(0).
atai(0).
wa(Q):-tasizan;saigo(Q);write('kesu'),kesu;assert(atai(0)).
tasizan:-atai(S),write(S),write(' '),waa(T),U is S + T,retract(waa(T)),
assert(waa(U)),fail.
saigo(Q):-waa(U),retract(waa(U)),V is Q + U,nl,write(V),assert(kotae(V)),
write('  <- result '),assert(waa(0)).
kesu:-retract(atai(S)),fail;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):-nl,write('*  '),l_disp(L1),nl,member(C,L2),write(C),hosei(C,Q),
write(Q),write(' -inb ** '),l_disp(L2),nl,keisan(Q,A,R),keisan2(R,S),write(S),
write(' <hosei | kero_mototi> '),write(A),write(' x2 ').
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).
nasi(C,0).
hosei(C,Q):-kiti(C,Q),write(' ').
hosei(C,Q):-not(kiti(C,Q)),nasi(C,Q),write(' <nasi> ').
keisan(Q,A,R):-R is Q * A.
keisan2(R,S):-S is R * 2,assert(atai(S)).
/*
第二部家系図の作成
kitiデータあると品種名の前に＊がつく以外自殖用と同じ
*/
ma('du1').
kakei(A):-d_clear,write('***  '),write(A),write('  の家系図  ***'),
c_era,nl,nl,sosen(A). 
kakei3(A):-d_clear,write('***  '),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.
/*
k<6を変えれば遡る世代数が変更される．k<7は＋１
*/
haha(A,X):-rr(A,X,_),cloc4(K),K<6.
titi(A,X):-rr(A,_,X),cloc4(K),K<6,nl,tab(K*18+1).
ari(X):-kiti(X,_),write('*');not(kiti(X,_)),write(' ').
cloc4(K):-clock(N),cloc2(M),cloc3(J),K is N+M-J.
sosen(A):-oya(A,X),kiru(X,Y),ari(X),write(Y),sosen(X).
sosen3(A):-mae(A),oya(A,X),kiru(X,Y),ari(X),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('***  '),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,[33092,33092,33092,33092,33092,33092,33092],Z),
Z=[X1,X2,X3,X4,X5,X6,X7,X8|Rest],
W=[X1,X2,X3,X4,X5,X6,X7,X8],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)).
/*
第３部家系図中祖先数などの計算
自殖用と同じ
*/
/*
総祖先数
*/
zenbu(A):-motoni,sosu(A).
zenbu(A):-write(' <= total sosen no kazu '),nl.
sosu(A):-pama(A,X),write(X),kazu(N),tab(1),write(N),sosu(X).
pama(X,Y):-tab(1),mama(X,Y).
pama(X,Y):-papa(X,Y).
mama(A,X):-rr(A,X,_).
papa(A,X):-rr(A,_,X),nl.
azukari(0).
kazu(N):-azukari(M),N is M+1,retract(azukari(M)),assert(azukari(N)).
motoni:-retract(azukari(N)),assert(azukari(0)).
/*
除共通
*/
zenbu2(A):-motoni2,sosu2(A).
zenbu2(A):-write(' <= kyotu nozoita sosen no kazu '),nl,motohe. 
motohe:-retract(fu(X)),fail,!.
fu('du1').
sosu2(A):-fue(A),pama2(A,X),write(X),kazu2(N),tab(1),write(N),sosu2(X).
pama2(X,Y):-tab(1),mama2(X,Y).
pama2(X,Y):-papa2(X,Y).
mama2(A,X):-rr(A,X,_).
papa2(A,X):-rr(A,_,X),nl.
fue(A):-fu(A),write(' - shown '),hiku(N),!,fail;assert(fu(A)).
azukari2(0).
kazu2(N):-azukari2(M),N is M+1,retract(azukari2(M)),assert(azukari2(N)).
hiku(N):-azukari2(M),N is M-1,write(N),retract(azukari2(M)),assert(azukari2(N)).
motoni2:-retract(azukari2(N)),assert(azukari2(0)).
/*
世代数
*/
sed(0).
sedai(A):-assert(azukari7(0)),fail.
sedai(A):-motoni4,saishu(A),fail. 
sedai(A):-sed(K),write(K),tab(1),fail,!.
sedai(A):-nl,write(' saidai sedai suu => '),hikaku,fail.
hikaku:-sed(K),hikaku2(K),fail,!.
hikaku2(K):-azukari7(M),K > M -> assert(azukari7(K)),retract(azukari7(M));!.
sedai(A):-azukari7(M),N is M + 1,write(N),nl,fail.
sedai(A):-retract(azukari7(M)),fail.
sedai(A):-motoni3.
pama3(X,Y):-tab(1),mama3(X,Y),kazu3(N).
pama3(X,Y):-papa3(X,Y),kazu4(N).
pama3(X,Y):-kazu5(N),fail.
mama3(A,X):-rr(A,X,_),azukari6(K),write(K),assert(sed(K)),tab(1).
papa3(A,X):-rr(A,_,X),azukari6(K),write(K),assert(sed(K)),tab(1),nl.
azukari6(K):-azukari3(N),azukari4(M),azukari5(J),K is N+M-J.
saishu(A):-pama3(A,X),write(X),saishu(X).
azukari3(0).
azukari4(0).
azukari5(0).
kazu7(M,L):-azukari7(M),retract(azukari7(M)),assert(azukari7(L)).
kazu5(N):-azukari5(M),N is M+1,retract(azukari5(M)),assert(azukari5(N)).
kazu4(N):-azukari4(M),N is M+1,retract(azukari4(M)),assert(azukari4(N)).
kazu3(N):-azukari3(M),N is M+1,retract(azukari3(M)),assert(azukari3(N)).
motoni4:-retract(azukari3(N)),assert(azukari3(0)),retract(azukari4(M)),
assert(azukari4(0)),retract(azukari5(J)),assert(azukari5(0)).
motoni3:-retract(sed(X)),fail,!.
/*
以上でプログラム本体終わり
*/
/*
以下他殖作物の家系分析漢字データサンプル
数字，アルファベットも全角にしないと家系図が乱れるが，計算はする．

まず'自分'の家系図を．'祖父'についた＊印は祖父の
近交係数値がデータベース中に存在することを示す．
次に'子６'又は'従姉妹'と'自分'間の近交係数を．
値は0.065625のはず（祖父の近交係数が０なら0.0625となる）．

さらに'子６'を含む計算を行うにはkiti('子６',0.065625)
をデータベースに追加する．この値は半角で．
祖父の近交係数0.1は説明上．通常は最終祖先の値は０である．
*/
/*
以下は"kin3"用データ（なくても可）．
*/
namae1('自分').
namae1('母').
namae1('父').
namae2('自分').
namae2('叔母').
/*
以下は交配親データ
rr('品種名', '母親名', '父親名').
kiti('品種名', その品種の近交係数値).
kitiなければ０とみなす．
*/
rr('自分','母','父').
rr('母','祖母','祖父').
kiti('祖父',0.1).
rr('妹','母','父').
rr('父','祖母２','祖父２').
rr('叔母','祖母','祖父').
rr('従姉妹','叔母','叔父').
rr('異母妹','継母','父').
rr('子１','妻','自分').
rr('子２','妹','自分').
rr('子３','母','自分').
rr('子４','叔母','自分').
rr('子５','祖母','自分').
rr('子６','従姉妹','自分').
rr('子７','異母妹','自分').
/*データおわり*/