You selected moji.pl
/* --------------------------------------------------------------
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].
% 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.
*/
return to front page.