/*  --------------------------------------------------------------
  strings utility
  edited: 12 Jan 2003.
  modified: 13 July 2003. prity print
  modified: 15 July 2003. prity print, forall print and tree print
  modified: 5-6 Feb 2005. hexa_list/3, hexa_1/2, hexa/3, bits/3, list_to_number/2
 --------------------------------------------------------------*/ 

% concat list
%-------------------------------------

concat_list(A,[A]).
concat_list(Z,[L|R]):- 
   concat_list(Q,R),
   concat(L,Q,Z).

% translate a list of numbers to a number
%-------------------------------------

list_to_number(A,[A]).
list_to_number(Z,[L|R]):- 
   length(R,N),
   list_to_number(Q,R),
   Z is 10^N*L+Q.

/*
% system predicates

?- atom_chars(123,A),number_chars(B,A).

A = ['1', '2', '3']
B = 123 

Yes
?- number_chars(B,['0','x','1','1']).

B = 17 

Yes
?-
*/

% hexa lists
%-------------------------------------
hexa_list(X,N,[Tx|Hx]):-
   \+ var(X),
   length(X,N),
   R is N mod 4,
   hexa_list_residual(R,X,Y,Tx),
   hexa_list_0(Y,Hx).

hexa_list_0([],[]).
hexa_list_0([A,B,C,D|X],[Hx|Y]):-
   hexa_list_0(X,Y),
   hexa_1([A,B,C,D],Hx).

hexa_list_residual(0,[A,B,C,D|X],X,Hx):-
   hexa_1([A,B,C,D],Hx).
hexa_list_residual(3,[A,B,C|X],X,Hx):-
   hexa_1([0,A,B,C],Hx).
hexa_list_residual(2,[A,B|X],X,Hx):-
   hexa_1([0,0,A,B],Hx).
hexa_list_residual(1,[A|X],X,Hx):-
   hexa_1([0,0,0,A],Hx).

% hexa and bits
%-------------------------------------
hexa_1(FourBits,Hx):-
   list_projection(FourBits,[a,b,c,d],_),
   bits(FourBits,Decimal,_B),
   hexa_pattern(Hx,Decimal).

hexa_pattern(Hx,Hx):-
   Hx <10,
   !.

hexa_pattern(Hx,D):-
   member((D,Hx),[
     (10,a),(11,b),(12,c),(13,d),(14,e),(15,f)
   ]).

hexa(L,Decimal,Hx):-
   concat_list(Hx,[0,x|L]),
   atom_chars(Hx,Atoms),
   number_chars(Decimal,Atoms).

bits(L,Decimal,B):-
   concat_list(B,[0,b|L]),
   atom_chars(B,Atoms),
   number_chars(Decimal,Atoms).

/*
% ISO definition: 0[box]<number>.
% binary, octal hexadecimal numbers.

?- A is 0x101.

A = 257 

Yes
?- 

*/



% forall print.
%-------------------------------------
% added: 15 July 2003.
forall_print(Y,X,[PrePrint,PostPrint]):-
  forall(member(Y,X),
    (
     PrePrint,
     write(Y),
     PostPrint
    )
  ).
forall_print(Y,X,[PrePrint,Goal,PostPrint]):-
  forall(member(Y,X),
    (
     PrePrint,
     Goal,
     PostPrint
    )
  ).



% prity print.
%-------------------------------------
% added: 13 July 2003.

align(left,N,M):- pp2(N,M).
align(right,N,M):- pp(N,M).

% left align
pp2(0,_,_).
%pp2(0,[],[]).
%pp2(0,Y,_Z):-   Y \= [],   pp2(0,[],[]).
pp2(N,[X|Y],[X|Z]):-
   N > 0,
   N1 is N -1,%(N1=0->trace;true),
   pp2(N1,Y,Z).
pp2(N,[],[' '|Z]):-
   N > 0,
   N1 is N -1,
   pp2(N1,[],Z).
pp2(N,X):-
   list_name(X,_Y,X1),
   pp2(N,X1,Z),
   list_name(Q,_W,Z),
   write(Q).
list_name0([],[]).
list_name0([X|Y],[Z|W]):-
   name(Z,[X]),
   list_name0(Y,W).

list_name(X,W,Y):-
   \+ var(X),
   name(X,W),
   list_name0(W,Y).
list_name(X,W,Y):-
   var(X),
   (\+ var(Y); \+ var(W)),
   list_name0(W,Y),
   name(X,W).

nstars(N):-
  length(L,N),
  forall(member(_X,L),write('*')).


% prity tree.
%-------------------------------------
% added: 13 July 2003.

print_tree(T):-
   nl,
   write('decision tree induced:'),
   nl,
   write('----------------------'),
   nl,
   print_tree(T,0).
print_tree(leaf(L),_):-
   tab(3),
   write(leaf(L)).
print_tree(tree(T,L),K):-
   N is 3 * K,
   tab(3),
   write(tree(T)),
   N1 is N + 3,
   tab(N1),write('|'),
   forall(member((V-S),L),
     (nl,
      tab(N1),
      write(':-'),
      write([V]),
      K1 is K + 1,
      print_tree(S,K1)
     )
   ).





%--------------------------------------%
% unparen(Body,DList,FlattenList)
%--------------------------------------%
% 節本体のカッコを外し、条件命題のリストを作成。
% 定数もアリティ０のファンクター。
% unparen(Body,A,A):-  Body =.. [A].
% 最後の一つがアリティ１以上のファンクターだと、上ではうまくいかない。
% 次のようにする。
%unparen(Body,Body,Body):-  functor(Body,F,_Arity),F\=','.
unparen(Body,[Body],[Body]):-  functor(Body,F,_Arity),F\=','.
%unparen(Body,[A,B]):-  Body =.. [(,),A,B].
%unparen(Body,[A,B,C]):-  Body =.. [(,),A,(B,C)].
unparen(Body,[H|B],F):-  Body =.. [(,),H,B1], unparen(B1,B,_),flatten([H|B],F).


%--------------------------------------%
% get_arities(Props,Arities,Terms)
%--------------------------------------%
% 節本体の条件命題リスト内の各ファンクターについてアリティを取得。
get_arities(Props,Arities):-
  bagof([F,A],
    P^(member(P,Props),
     functor(P,F,A)
    ),
   Arities
  ).


%--------------------------------------%
%   search
%--------------------------------------%

% find string
find(X,Y,S):- \+var(X),find(X,Y,S,_L,_L1).
find(X,Y,S):- var(X),mid(Y,_,_,X),find(X,Y,S,_L,_L1).
find(X,Y,1,L,L1):- 
	string_to_list(X,L),
	string_to_list(Y,L1),
	subset(L,L1),
	append(L,_,L1).
find(X,Y,P,L,[_|L1]):-
	string_to_list(X,L),
	string_to_list(Y,[_|L1]),
	string_to_list(Y1,L1),
	find(X,Y1,P1,L,L1), 
	%read(y),write(find(X,Y1,P,L,L1)),
	P is P1 + 1.

% left, right, mid -- excel-like string functions. 
left(_,0,'').
left(X,L,Y):-
	string_length(X,N),
	length(P,N),
	nth1(L,P,L),
	string_to_list(X,XL),
	findall(A,(nth1(K,XL,A),K =< L),YL),
	name(Y,YL), %string_to_list(Y,YL),
	string_length(Y,L).
right(_,0,'').
right(X,R,Y):-
	string_length(X,N),
	length(P,N),
	nth1(R,P,R),
	string_length(X,N),
	L is N - R,
	string_to_list(X,XL),
	findall(A,(nth1(K,XL,A),K > L),YL),
	name(Y,YL), %string_to_list(Y,YL),
	string_length(Y,R).
mid(X,L,R,Y):-
	substring(X,L,R,Y).
substring(X,S,W,Y):-
	\+ var(S),
	\+ var(W),
	L is S - 1,
	R is L + W,
	left(X,R,LX), % cut the tail.
	right(LX,W,Y). % cut the head.
substring(X,S,W,Y):-
	(var(S);var(W)),
	string_length(X,N),
	length(P,N),
	nth1(S,P,S),
	L is S - 1,
	M is N - S + 1,
	nth1(W,P,W),
	W =< M,
	R is L + W,
	left(X,R,LX), % cut the tail.
	right(LX,W,Y). % cut the head.
% meta
show(P):-
	clause(P,true),
	P,
	tab(2),write('fact: '),write(P),nl.
show(P):-
	clause(P,Q),
	P,
	\+ Q = true,
	tab(2),write('rule: '),write(P),
	write(':-'),nl,
	tab(8),write(Q),nl.

%--------------------------------------%
% moji henkan
%--------------------------------------%
% 日本語文字列リスト->文字列コードリスト
jchar_to_list([],[]).
jchar_to_list([L|R],Z):-
	string_to_list(L,C),append(C,Z1,Z),jchar_to_list(R,Z1).



% numerical symbols
% in swipl, any floating number is represented by a code list with length 8.
% thus we want to translate a numerical symbol such as '0.61'  as is, i.e., 
% [48,46,54,49] appended with 0-list [48,48,48,48] but not as 
% [48,46,54,48,57,51,55,53], probably a rounded error you may 
% recognize that it represents '0.609375' by using string_to_list.  
% Even though, this cannot be intrpreted as a number. We will hold it, 
% for example, as a formula_dec('0.61',61,-2).
number_to_list(S,N,L,K):-
	% S: a string which represents a number
	% N: the length of S.
	% K: the number
	% L: the ocde list of K   (with length 8)
	string_length(S,N),
	findall(C,
	  (
	   substring(S,J,1,A),
	   (is_num(A,C);
	    (J==2,[C]=".",string_to_list(A,[C]))
	   )
	  ),
	L),
	string_to_list(K,L).

is_num(K,A):-
	B=[0,1,2,3,4,5,6,7,8,9],
	member(K,B),
	string_to_list(K,[A]).% A is 48 + K
anumber(K,L,U):-
   length(P,U),
   nth1(K,P,K),
   K >= L,
   K =< U.
is_numbers(X,C,1):-is_num(X,C).
is_numbers(X,[CN|C],K1):-
	is_numbers(Y,C,K),
	is_num(N,[CN]),
	K1 is K + 1,
	concat(N,Y,X).




% 文字列中に含まれる金額を表す語句

q_yen(Y,S,K,A,Q,L):- 
	qj_list(2,A,Q,_X,L),
	kazu(hajime,_,S,S,L),
	q_kazu(Y,S,K,A,Q,L),
	\+ (q_kazu(_Y1,S,K1,A,Q,L),K1 > K).
q_kazu(N,S,K,A,Q,L):- 
	qj_list(2,A,Q,_X,L),
	kazu(_Z,N,S,K,L).

kazu(hajime,N,1,1,L):-
	nth1(1,L,[N,C,T]),
	member([N,C,T],[[N,_,e(number)],['￥',_,j(jyen)],['\',_,e(yen)]]).
kazu(hajime,N,K,K,L):-
	nth1(K,L,[N,C,T]),
	member([N,C,T],[[N,_,e(number)],['￥',_,j(jyen)],['\',_,e(yen)]]),
	K > 1, K0 is K - 1,
	\+kazu(_,_,_,K0,L).
kazu(naka,N1,S,K,L):-
	nth1(K,L,[N,C,T]),
	member([N,C,T],[[N,_,e(number)],[_,[44],e(kigou)]]),
	K > 1, K0 is K - 1,
	kazu(_,N0,S,K0,L),
	concat(N0,N,N1).
kazu(owari,N1,S,K,L):-
	nth1(K,L,[N,_,j(kjyen)]),
	K > 1, K0 is K - 1,
	member(T,[hajime,naka]),
	kazu(T,N0,S,K0,L),
	concat(N0,N,N1).
/*
kazu(owari,N1,S,K,L):-
	nth1(K,L,[N,C,T]),
	member([N,C,T],[[N,_,e(number)]]),
	K > 1, K0 is K - 1,
	member(T,[hajime,naka]),
	kazu(T,N0,S,K0,L),
	concat(N0,N,N1),
	K1 is K + 1,
	nth1(K1,L,[N1,C1,T1]),
	Continue=[[N,_,e(number)],[_,[44],e(kigou)],[N,_,j(kjyen)]],
	\+member([N1,C1,T1],Continue).
*/



% 文字列中に含まれる任意の語句を日本語コード変換して文字列操作する。
hyakuen('100円').  % テスト用
phrase(A,B,[N,Q],[S,K]):-
	var(A),
	'問'(N,_,Q),
	j_list(0,Q,_L,Q0),
	mid(Q1,Q0,[S,K]),%write(mid(Q1,Q0,[S,K])),
	jchar_to_list(Q1,B),
	string_to_list(A,B).
phrase(A,L,[N,Q],[S,K]):-
	\+ var(A),
	j_list(0,A,L,Q1),
	'問'(N,_,Q),
	j_list(0,Q,_L0,Q0),
	mid(Q1,Q0,[S,K]).
mid(L1,L,[1,K]):-
	\+ var(L),
	append(L1,_,L),
	length(L1,K).
mid(L1,[_|L],[S,K]):-
	mid(L1,L,[S1,K]),
	\+ var(L),
	length(L1,K),
	S is S1 + 1.

%　最後の半角英数文字は省略される（通常日本語文は「。」で終わると仮定する。）
j_list(0,Q,L,Q1):-string_to_list(Q,L),
	bagof(S,
	  K^C^C1^M^(
		nth1(1,C,C1),nth1(K,L,C1),
		moji_hantei(S,K,L,C,M),!
	 ),
	Q1).
j_list(1,Q,L,Q1):-string_to_list(Q,L),
	bagof([S,M],
	  K^C^C1^M^(
		nth1(1,C,C1),nth1(K,L,C1),
		moji_hantei(S,K,L,C,M),!
	 ),
	Q1).
j_list(2,Q,L,Q1):-string_to_list(Q,L),
	bagof([S,C,M],
	  K^C^C1^M^(
		nth1(1,C,C1),nth1(K,L,C1),
		moji_hantei(S,K,L,C,M),!
	 ),
	Q1).
moji_no_hajimari(1,_,_).
moji_no_hajimari(K,L,C1):-
	K > 1,
	K1 is K - 1, 
	moji_hantei(_,K1,L,[_,C1],e(_));
	\+moji_hantei(_,K1,L,[_,C1],j(_)).
moji_hantei(S,K,L,[C1,C2],j(M)):-
	two_seq([C1,C2],K,L),
	jmoji(S,[C1,C2],M),%write((S,[C1,C2],M)),
	moji_no_hajimari(K,L,C1).
moji_hantei(S,K,L,[C1],e(M)):-
	two_seq([C1,_C2],K,L),
	eisu(S,[C1],M),
	moji_no_hajimari(K,L,C1).
moji_hantei(S,K,L,[C2],e(M)):-
	length(L,K),
	nth1(K,L,C2),
	eisu(S,[C2],M),
	K > 1, K1 is K - 1,
	two_seq([C1,C2],K1,L),
	\+moji_hantei(_,K1,L,[C1,C2],j(_)).

two_seq([C1,C2],K1,L):-
	nth1(K1,L,C1),	%1 is K1 mod 2,
	K2 is K1 + 1,	nth1(K2,L,C2).

% added: 2 Nov 2002. 
jmoji(A,X,B):-
	(is_jnum(A,X),B=jnumber);
	(jyen(A,X),B=jyen);
	(kjyen(A,X),B=kjyen);
	(jmoji1(A,X),B=jmoji);
	(kanji(A,X),B=kanji);
	(jkigou(A,X),B=jkigou).

is_jnum(B,[A]):-
	B=['０','１','２','３','４','５','６','７','８','９'],
	string_to_list(B,[A]).
jyen('￥',C):-string_to_list('￥',C).
kjyen('円',C):-string_to_list('円',C).
kanji(X,[C1,C2]):-
	C1 >= 137, C1 =< 160,
	string_to_list(X,[C1,C2]).
jkigou(X,[C1,C2]):-
	[C1,C2] @>=  [135, 64],
	[C1,C2] @=< [135, 117],
	string_to_list(X,[C1,C2]).
jmoji1(X,[C1,C2]):-
	string_to_list(X,[C1,C2]), C1 >=129, C1 < 131.

eisu(A,X,B):-
	(is_num(A,X),B=number);
	(yen(A,X),B=yen);
	(emoji(A,X),B=emoji);
	(cap_emoji(A,X),B=cap_e);
	(kigou(A,X,_Q),B=kigou).
%'a to z'
emoji(A,[C]):-string_to_list(A,[C]),C >= 97, C =<122.


%'A to Z'
cap_emoji(A,[C]):-string_to_list(A,[C]),C >= 65, C =<90.

% alphabetical symbols
cap_echar(A,C,K):-
	echar(A,C),
	C >= 65, C =<90,
	K is C - 64.
cap_echar(A,C):-
	echar(A,C),
	C >= 65, C =<90.
lower_echar(A,C):-
	echar(A,C),
	C >= 97, C =<122.
echar(A,C):-
	length(P,122), 
	nth1(C,P,C),
	C >= 65, C =<122,
	string_to_list(A,[C]).
yen('\',[C]):-string_to_list('\',[C]).
kigou(A,[C],Q):-
   Q1 = [32,33,34,35,36,37,38,39,40,41],   %' !"#$%&''()' 
   Q2 = [42,43,44,45,46,47],  % '*+,-./' 
   Q3 = [59,60,61,62,63,64],  % ';<=>?@' 
   Q4 = [91,92,93,94,95,96],  % '[\]^_`' 
   Q5 = [123,124,125,126],   % '{|}~' 
   nth1(_K,[Q1,Q2,Q3,Q4,Q5],CQ),
   string_to_list(Q,CQ),%write(Q),
   member(C,CQ),%write(ascii(C)),
   string_to_list(A,[C]).


is_currency(1,X,C,K):-is_currency1(X,C,K).
is_currency(2,X,C,K):-is_currency2(X,C,K).
% 注意：以下のやり方だとP=2としたときどうなるか。
%is_currency(X,C,K,P):-
%	(is_currency1(X,C,K),P=1);
%	(is_currency2(X,C,K),P=2).

is_currency1(X,C,K1):-
	is_curr_num(Y,C1,_K),kjyen(Yen,CY),
	%\+ (0 is K mod 4), 
	concat(Y,Yen,X),
	append(C1,CY,C),length(C,K1).
is_currency2(X,C,K1):-
	(yen(Yen,CY);jyen(Yen,CY)),is_curr_num(Y,C1,_K),
	%\+ (0 is K mod 4),
	concat(Yen,Y,X),
	append(CY,C1,C),length(C,K1).

is_curr_num(X,C,1):-is_num(X,C).
is_curr_num(X,[CN|C],K1):-
	is_curr_num(Y,C,K), %write((Y,C,K)),
	(3 is K mod 4
	 -> (string_to_list(',',[CN]), N = ',', K1 is K + 1)
	  ; (is_num(N,[CN]), K1 is K + 1)
	),
	concat(N,Y,X).



/*
% 差分リスト表現された日本語問題文から一部分を抜き出すルール
'問題文'(a1,'取引：'-'100円'-'の'-'商品'-'を'-'販売し'-'，'-'代金'-'は'-'現金'-'で'-'受け取った。').
'金額d'(Y,Q,L):-d_member(_-Yen,Q,L),concat(Y,'円',Yen).
'金額d'(Y,Q,L):-d_member(_-Yen,Q,L),member(X,['\','￥']),concat(X,Y,Yen).
dd_member(X,Y):-dd_member(X,Y,_).
dd_member(X,Y,L):-d_member(_A-X,Y,L).
dd_member(X,Y,L):-d_member(X,Y,L),\+d_member(_-_,X,_).
d_member(X,Y):-d_member(X,Y,_).
d_member(X,X,1).
d_member(X,Y-_,K):-d_member(X,Y,K1),K is K1 + 1.
*/