/*

   AZ-PrologV9 素性構造マネージメントユーティリティ
     2015.12.15 T.Inaba SOFNEC.CO.JP

   ・素性構造：        空または、<素性とその値の組>だけからなる中括弧構造
                       <例> {}        { category:noun, number:single, phon:dog }
                       
   ・素性とその値の組: 素性と値を素性区切り記号で結びつけたペア
                       <例> category:noun
                    
   ・素性：            アトムであり、以下では素性名とも表記される。
                       <例> category

   ・値：              素性構造を含むすべての項
                       <例>  noun ,X ,{kind_of:animal,size:middle} ,[spitz,bulldog]

                       変数には制約(領域、遅延実行ゴール）を記述することができるが、
                       プログラムはmacro_consult/1,
                       redisからのGet,readにおいてはs_constraints_mode(_,on)のときのみ展開する。

                       <例>  a(age:X#[0..100]).
                             a({number:Num#(Num\==single -> atom_append(P,s,Phon);P=Phon),base:P,phon:P}).

   ・素性区切り記号：  素性構造の中で使われる特殊オペレータ。
                       入力、表示のデフォルトは、':'であり、CU-Prolog由来のプログラムをそのまま使うなど、特別必要な場合は、
                       fs_delimiter/2 にて切り替えることができ, 切り替えることで、ヒープ・スタック上の
                       素性構造の要素表示も一括して切り替わるが、素性構造から取り出した要素を扱うプログラムの区切り記号は変わらないので、注意が必要である。
                       素性構造から取り出された<素性とその値の組>を素性名と値に分解するまたはその逆は、直接おこなうのではなく、本ユーティリティのfs_av/3を利用するのが安全である。

                       ?- assert(dict(dog,{category:noun,number:single})).
                       ?- fs_delimiter(F,/ ).
                        F = :
                       ?- listing.
                       dict(dog,{category/noun,number/single}).
                       
                       ?- dic(dog,FS),fs_list(FS,[AV|_]),fs_av(AV,A,V).
                       FS  = {category/noun,number/single}
                       AV  = category/noun
                       _.1 = [number/single]
                       A   = category
                       V   = noun

   ・素性構造同士のユニフィケーション

     素性構造１と素性構造２の同一階層に同じ素性名があったときには、その素性値同士が再帰的に単一化がおこなわれる。
     素性構造１と素性構造２の同一階層に同じ素性名がないときはない側にその<素性と値の組>が追加される。
     要素の出現順序によらず、また部分要素でも単一化が行われる。
     
    ?- X = { category:noun,phon:dog }, Y={phon:P} ,X=Y.
       X = { category:noun,phon:dog }
       Y = { category:noun,phon:dog }
       P = dog
    yes
   ?- X = { category:noun,phon:dog }, Y={phon:cat} ,X=Y.
    no
    
   ・素性構造同士の差分構造

　　　素性構造の差分を表現することができる。
　　　これにより、要素の削除、構造の置き換えなどが容易に可能。
    ?- X={a:b,c:d,e:f},X={c:d|T}.
      T = {a:b,e:f}
      yes
    ?- X={a:b,c:d,e:f},X={c:A,a:Q|T},Y={a:A,c:Q|T}.
      X = {c:d,a:b,e:f}
      T = {e:f}
      A = d
      Q = b
      Y = {a:d,c:b,e:f}
      yes
*/

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% [1] fs_av/3     FeatureStructureElement <==> Attribute,Value
%% この述語は直接使う局面はほとんどないかもしれないが。 
%% 素性区切り記号を切り替えることが前提の場合、必須
%%
%% (1) 素性名と値から<素性と値の組>を生成
%% ?- fs_av(AV,a,aaaa),fs_body(FS,(AV,_)).    AV = a:aaaa,FS = {a:aaaa}
%%
%% (2) <素性と値の組>から素性名と値を取り出す
%% ?- fs_body({a:bb},(AV,_)),fs_av(AV,A,V).   A = a, V = bb

:- public fs_av/3.
fs_av(AV,A,V):- fs_delimiter(D,D),AV=..[D,A,V],atom(A).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% [2] fs_body/2 (1)素性構造のコア構造を ','/2 で取り出す。
%%               (2)コア構造を素性構造に変換
%% ?- fs_body({a:aa,b:bb},B).      B=(a:aa,b:bb,_)  <-- (注)最終要素は変数
%% ?- fs_body(F,(a:aa,b:bb,_)).    F={a:aa,b:bb}

:- public fs_body/2.
fs_body(FS,Body):- FS=..['{}',Body,_,[]].

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% [3] fs_new/3
%% Arg1を素性名、Arg2を値とする素性構造を生成し、Arg3に単一化する
%%
%% ?- fs_new(a,aaa,X).             X  = {a:aaaa}
%% ?- Q=q,fs_new(Q,S,X).           X  = {q:S}
%% ?- X={a:b},Q=q,fs_new(Q,S,X).   X  = {a:b,q:S}

:- public fs_new/3.
fs_new(A,V,FS):- fs_av(AV,A,V),fs_body(FS,(AV,_)).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% [4] fs_list/2   (1)素性構造の全要素をリストに展開する,
%%                 (2)リストを素性構造に変換する
%% ?- fs_list({category:noun_phrase,number:singular},L).
%% L = [category:noun_phrase,number:singular]

%% ?- fs_list(FS,[category:noun_phrase,number:singular]).
%% FS = {category:noun_phrase,number:singular}

%% ?-X={a:bb,c:dd},fs_list(X,L),fs_list(X,[e:qq]).
%% X       = {a:bb,c:dd,e:qq},
%% L       = [a:bb,c:dd]

:- public fs_list/2.

fs_list(FS,List):-fstructure(FS),var(List),!,fs_body(FS,Body),fs_list_sub(Body,List).
fs_list(FS,List):-fs_list_sub(Body,List),fs_body(FS,Body).

fs_list_sub((FF,B),[FF|C]):- nonvar(FF),!,fs_list_sub(B,C).
fs_list_sub(_,[]).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% [5] fs_member/2 ある素性：値が素性構造に含まれているか調べる
%%  
%% ?- fs_member(number:X,{category:noun_phrase,number:singular}).
%% X = singular
%%
%% ?- fs_member(number:X,{category:noun_phrase,number:Y}).
%% X = X_20, Y = Y_22
%% yes
%%
%% ?- fs_member(number:d,{category:noun_phrase,number:X}).
%% no
%%
%% ?- fs_member(number:X,{category:noun_phrase,number:{p:Y}}).
%% X = {p:_20}, Y = Y_22
%% yes
%% ?-fs_member(a:{b:bb,c:X},{a:{c:1,b:bb}}).
%% X       = 1
%% yes

:- public fs_member/2.
fs_member(AV,FS):- var(AV),!,fs_list(FS,List),member(AV,List).
fs_member(AV,FS):- fs_body(FS,B),fs_member1([AV],B).

fs_member1([],_):-!.
fs_member1([AV|L],B):-
	fs_av(AV,A,V),fs_av(AV2,A,V2),
	pvalue_sub(B,AV2),fs_member2(V,V2),fs_member1(L,B).

fs_member2(V,V2):- 
	fstructure(V),!,fstructure(V2),
	fs_list(V,L),fs_body(V2,B),fs_member1(L,B).
fs_member2(V,V2):-var(V),var(V2),!.
fs_member2(V,V2):-var(V2),!,fail.      % true?
fs_member2(V,V2):-var(V),!,fs_copy1(V2,V,[],_).
fs_member2(V,V2):-atomic(V),atomic(V2),!,V=V2.
fs_member2([A|AL],[B|BL]):- !,fs_member2(A,B),fs_member2(AL,BL).
fs_member2(A,B):- A=..[F|AL],B=..[F|BL],fs_member2(AL,BL).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% [6] fs_copy/2    素性構造のコピー
%%
%%  ?- s_constraints_mode(_,on).
%% yes
%%  ?- X={a:P#(P=A),b:A},fs_copy(X,Y),Y={a:aa}.
%%     X       = {a:_75,b:A_63},
%%     P       = _75,
%%     A       = A_63,
%%     Y       = {a:aa,b:aa}

:- public fs_copy/2.
fs_copy(FS,Copy):- fstructure(FS),fs_copy1(FS,Copy,[],_).

fs_copy1(X,X,V,V):- atomic(X),!.
fs_copy1(V,V2,VList,OVList):- var(V),!,fs_queue(V,V2,VList,VList,OVList).
fs_copy1(FS,Copy,VList,OVList):- fstructure(FS),!,fs_body(FS,B),fs_copy1(B,NewB,VList,OVList),fs_body(Copy,NewB).
fs_copy1([A|B],[C|D],VList,OVList):- !,fs_copy1(A,C,VList,OVList1),fs_copy1(B,D,OVList1,OVList).
fs_copy1(Tm,NTm,VList,OVList):-  Tm=..[F|L],fs_copy1(L,R,VList,OVList),NTm=..[F|R].

fs_queue(V,V2,VL,[],Z):- !, fs_copy_clp(V,V2,VL,Z).
fs_queue(V,V2,VL,[V3,V2|L],VL):- V==V3,!.
fs_queue(V,V2,VL,[V3,V4|L],Z):- fs_queue(V,V2,VL,L,Z).

fs_copy_clp(V,V2,VL,Z):- get_clp_area(V,VA),!,put_clp_area(V2,VA),fs_copy_clp2(V,V2,VL,Z).
fs_copy_clp(V,V2,VL,Z):- fs_copy_clp2(V,V2,VL,Z).

fs_copy_clp2(V,V2,VL,Z):- frozen(V,Vfr),Vfr \== true,!,fs_copy1(Vfr,Vfr2,[V,V2|VL],Z),freeze(V2,Vfr2).
fs_copy_clp2(V,V2,VL,[V,V2|VL]).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% [7] fs_append/3  二つの素性構造を元の素性構造は変えずに結合した新しい素性構造を生成しArg3に単一化
%% ?- X={a:S,b:bb},Y={b:Q,e:S},fs_append(X,Y,Z).
%%   X  = {a:S_62,b:bb},
%%   Y  = {b:Q_70,e:S_62},
%%   Z  = {b:bb,e:_160,a:_160}
%%
%% 単純に二つの素性構造を結合するだけなら、素性構造のユニフィケーションでよい。
%% ?- X={a:aa},Y={b:bb},X=Y.         X= {a:aa,b:bb}, Y= {a:aa,b:bb}

:- public fs_append/3.
fs_append(X,Y,Z):- fs_copy1(X,Z,[],VL),fs_copy1(Y,Z,VL,_).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% [8] fs_appends/2  複数の素性構造を結合した新しい素性構造を生成する
%%
%% ?-X={a:S,b:bb},Y={b:Q,e:Q},fs_appends([X,Y,{a:Q}],D).
%% X       = {a:S_70,b:bb},
%% S       = S_70,
%% Y       = {b:Q_78,e:Q_78},
%% Q       = Q_78,
%% D       = {a:bb,b:bb,e:bb}

:- public fs_appends/2.
fs_appends(List,Z):- fs_appends(List,AA,[],Z).

fs_appends([],Z,_,Z):-!.
fs_appends([A|B],F,Q,Z):- fs_copy1(A,F,Q,NQ),fs_appends(B,F,NQ,Z).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% [9]  pnames/2  (Cu-Prolog 組込互換） 
%% pnames(PST+,FL) PST の素性名のリストをFL と単一化する
%% ?- pnames({l:a,m:b},L).  L = [l,m]

:- public pnames/2.
pnames(FS,L):- fs_body(FS,B),pnames_sub(B,L).

pnames_sub(B,[]):- var(B),!.
pnames_sub((A,B),[F|L]):- !,arg(1,A,F),pnames_sub(B,L).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% [10]  pvalue/3  (Cu-Prolog 組込互換/拡張） 
%% pvalue(PST+,F+,V) PST の素性F の値をV と単一化する
%% PST に相当する素性がない場合にはfail する
%% ?- pvalue({a:aa,b:bb,c:cc},b,V).        V = bb
%% ?- pvalue({a:aa,b:{e:bb},c:cc},b:e,V).  V = bb

:- public pvalue/3.

pvalue(FS,A,V):- fstructure(FS),fs_body(FS,Body),fs_pvalue2(Body,A,V).

fs_pvalue2(B,A,V):- atom(A),!,fs_av(AV,A,V),pvalue_sub(B,AV).
fs_pvalue2(B,A:X,V):-
	fs_av(AV,A,Z),pvalue_sub(B,AV),fs_body(Z,B2),fs_pvalue2(B2,X,V).

pvalue_sub(B,_):- var(B),!,fail.
pvalue_sub((AV,_),AV):- !.
pvalue_sub((_,B),AV):- pvalue_sub(B,AV).

/*
%% ### 差分表現導入によりfs_replace/4,fs_rm/3 廃止 ###
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% [xx]  fs_replace/4
%% 素性構造中の特定素性名を変更
%% ?- fs_replace({a:aa},New,a,b).    New={b:aa}
%% ?- X={a:aa,f:bb},X={a:A|T},New={b:A|T}.

:- public fs_replace/4.
fs_replace(FS,NewFS,A,A2):- 
	fs_body(FS,Body), fs_av(Now,A,V),fs_av(New,A2,V),
	fs_replace_sub(Body,NewBody,Now,New),
	fs_body(NewFS,NewBody).

fs_replace_sub(X,_,_,_):- var(X),!,fail.
fs_replace_sub((A,Z),(B,Z),A,B):- !.
fs_replace_sub((X,Z),(X,Y),A,B):- fs_replace_sub(Z,Y,A,B).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% [xx]  fs_rm/3
%% 素性構造中の特定素性を削除
%% ?- fs_rm({a:aa,b:bb},New,b).
%% ?- X={a:aa,b:bb},X={b:_|New}.

:- public fs_rm/3.
fs_rm(FS,New,A):- 
	fs_body(FS,Body),fs_av(Del,A,_),fs_rm_sub(Body,NewBody,Del),fs_body(New,NewBody).

fs_rm_sub(X,_,_):- var(X),!,fail.
fs_rm_sub((A,Z),Z,A):- !.
fs_rm_sub((X,Z),(X,Y),A):- fs_rm_sub(Z,Y,A).
*/

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% [11] fs_writeAVM/1   素性構造をAVM形式で出力する

/*
test1:-
    S={a:aaaaaaaaa,b:[1,2,3],c:{a:XXXXXXXXXXXXXXXXXXXX,b:{a:aa,b:a}}},
    fs_writeAVM(S).
test2:- 
    S={ 氏名:山田太郎,生年月日:{年:1951,月:5,日:26,時:{時:18,分:6}},趣味:X },
    fs_writeAVM(S).

 ?- test2.
  |~                       ~|
  | 氏名     山田太郎       |
  | 生年月日 |~          ~| |
  |          | 年 1951    | |
  |          | 月 5       | |
  |          | 日 26      | |
  |          | 時 |~   ~| | |
  |          |    |時 18| | |
  |          |    |分 6 | | |
  |          |    |_   _| | |
  |          |_          _| |
  |                         |
  | 趣味     _7             |
  |_                       _|

yes
*/

:- op(550,xfx,&).
:- run:op(550,xfx,&).

:- public fs_writeAVM/1.
fs_writeAVM(FS):-
        kanji_mode(OnOff,on),
          fs_make_AVM(FS,MaxVLen,Struct),
          fs_write_AVM(Struct,MaxVLen,[' '],[' '],[]),
        kanji_mode(_,OnOff).
%%%%%%%%%%%%%
fs_make_AVM(Type&V,ALen1+VLen1+5, fs(Type/TLen,ALen1+VLen1,List)):-
        fstructure(V),!,atom(Type,TLen),
        fs_list(V,FL),fs_make_AVM2(FL,0,TLen,ALen1,VLen1,List).
fs_make_AVM(V,ALen1+VLen1+5, fs(''/0,ALen1+VLen1,List)):-   % SP+|~ALen1VLen1~|
        fstructure(V),!,fs_list(V,FL),fs_make_AVM2(FL,0,0,ALen1,VLen1,List).
fs_make_AVM(V,VLen1+5, fs_list(VLen1,List)):-   % SP+|~ALen1VLen1~|
	list(V), \+ fs_string(V),!,V=[A|L],
	fs_make_AVM_list(V,0,VLen1,List).
fs_make_AVM(V,VLen1,         notfs(VLen1,V)):-         % SP+VLen1
        term_string(V,L),fs_e_length(L,1,VLen1).

fs_make_AVM_list([],VL,VL,[]):-!.
fs_make_AVM_list([A|L],VL0,VL,[AA|LL]):-
	fs_make_AVM(A,VL1,AA),
	NextVL is max(VL0,VL1),
	fs_make_AVM_list(L,NextVL,VL,LL).
 %%
fs_make_AVM2([],MaxALen,MaxVLen,MaxALen,MaxVLen,[]):-!.
fs_make_AVM2([AV|L],ALen0,VLen0,MaxALen,MaxVLen,[Attr/(MaxALen-ALen)-Value|R]):-
        fs_av(AV,Attr,V),
        term_string(Attr,Astring),fs_e_length(Astring,0,ALen),
        NextALen is max(ALen,ALen0),
        fs_make_AVM(V,NewVLen,Value),
        NextVLen is max(NewVLen,VLen0),
        fs_make_AVM2(L,NextALen,NextVLen, MaxALen,MaxVLen, R).
 %%
fs_e_length([],L,L):-!.
fs_e_length([A|R],L,N):- (e_kanji(A)->M is L+2;M is L+1),fs_e_length(R,M,N).
%%%%%%%%%%%%%
fs_write_AVM( fs(Type/TLen,MyLen,FSList),MaxVLen,Attribute,NextHead,Tail):-
        !,['|',tab(MaxVLen-(MyLen+4))|Tail]  = NextTail,
        fs_outf(Attribute+['|~',Type,tab(MyLen-TLen),'~'|NextTail]),nl, % |~
          fs_write_AVM2(FSList,MyLen,NextHead+['|'], NextTail),         % | a
        fs_outf( NextHead+['|_',tab(MyLen),'_'|NextTail]),nl.           % |_
fs_write_AVM( fs_list(MyLen,FSList),MaxVLen,Attribute,NextHead,Tail):-
        !,['  ',tab(MaxVLen-(MyLen+4))|Tail]  = NextTail,
        fs_outf(Attribute+[' [',tab(MyLen)|NextTail]),nl,               % [
          fs_write_AVM_list(FSList,0+MyLen,NextHead, NextTail,' '),     %   a
        fs_outf( NextHead+[' ]',tab(MyLen)|NextTail]),nl.               % ]
fs_write_AVM( notfs(MyLen,Value),MaxVLen,Attribute,_,Tail):-
        fs_outf(Attribute+[q(Value),tab(MaxVLen-MyLen+1)|Tail]),nl.
 %%
fs_write_AVM2([],_,_,_):-!.
fs_write_AVM2([Attr/ALeft-Value|L],MaxALen+MaxVLen,Head,Tail):-
        fs_write_AVM(Value,MaxVLen,Head+[' ',q(Attr),':',tab(ALeft)], %Attribt
                                   Head+[tab(MaxALen+2)],Tail), %NextHead
        fs_write_AVM2(L,MaxALen+MaxVLen,Head,Tail).

fs_write_AVM_list([],_,_,_,_):-!.
fs_write_AVM_list([Value|L],MaxALen+MaxVLen,Head,Tail,Del):-
        fs_write_AVM(Value,MaxVLen,Head+[' ',Del],              %Attribt
                                   Head+[tab(MaxALen+2)],Tail), %NextHead
        fs_write_AVM_list(L,MaxALen+MaxVLen,Head,Tail,',').
 %%
fs_outf([]):- !.
fs_outf([tab(T)|L]):- !,tab(T),fs_outf(L).
fs_outf([q(W)|L]):-   !,writeq(W),fs_outf(L).  % Attribt,notFS
fs_outf([N|L]):-      !,write(N),fs_outf(L).   % Only Space;|;|~;~;_
fs_outf(A+B):-fs_outf(A),fs_outf(B).

fs_string([]):-!.
fs_string([A|L]):- atomic(A),fs_string(L).

