このディレクトリの索引
% これは高名な和歌サイトである千人万首(よよのうたびと)から
% 指定した歌人の歌のみを抽出してくるPrologプログラムです。
% 著作権を侵害している可能性がありますが、あくまでPrologによるwwwサイトの
% 検索事例として受け止めていただきたい。
% 最初に実行例を示します。

?- 千人万首表示(皇嘉門院別当).
しのびねの袂は色にいでにけり心にも似ぬわが涙かな

思ひ川いはまによどむ水茎をかきながすにも袖は濡れけり

うれしきもつらきも同じ涙にて逢ふ夜も袖はなほぞかわかぬ

難波江の葦のかりねの一よゆゑ身をつくしてや恋ひわたるべき

かへるさは面影をのみ身にそへて涙にくらす有明の月

雲もなくなぎたる空のあさみどりむなしき色も今ぞしりぬる

yes.
?- 

% *** user: '千人万首表示' / 1 ***
'千人万首表示'(_歌人) :-
    abolish('千人万首リンク情報' / 3),
    '千人万首リンク情報の登録',
    '千人万首'(_歌人,X),
    \+(X = []),
    (
        member(A,X),
        wr('%t\n\n',[A]),
        fail
    ;
        abolish('千人万首リンク情報' / 3)
    ),
    ! .

% *** user: '千人万首リンク情報の登録' / 1 ***
'千人万首リンク情報の登録'([]) :-
    ! .
'千人万首リンク情報の登録'([<,a,' ',h,r,e,f,=,'"'|R]) :-
    '千人万首リンク情報の登録_1'(R,L,Y,R2),
    replace_all(Y,'','',Y2),
    replace_all(Y2,'','',_歌人),
    concat_atom(L,A),
    concat_atom(['/~sg2h-ymst/yamatouta/',A],URL),
    assertz('千人万首リンク情報'(_歌人,'www.asahi-net.or.jp',URL)),
    '千人万首リンク情報の登録'(R2),
    ! .
'千人万首リンク情報の登録'([_|R]) :-
    '千人万首リンク情報の登録'(R) .

% *** user: '千人万首リンク情報の登録' / 0 ***
'千人万首リンク情報の登録' :-
    http_client('www.asahi-net.or.jp','/~sg2h-ymst/yamatouta/sennin.html#a',[sjis,'本文'],X),
    千人万首リンク情報の登録(X),!.

千人万首リンク情報の登録(L) :-
    member(A,L),
    atom_chars(A,AL),
    千人万首リンク情報の登録(AL),
    fail.
千人万首リンク情報の登録(_).

% *** user: '千人万首' / 3 ***
'千人万首'(Host,File,Y) :-
    http_client(Host,File,[sjis,'本文'],X),
    findall(U,('千人万首_member'(U0,X) , (sub_atom(U0,0,16,R0,'

') , sub_atom(U0,16,R0,_,U1) ; sub_atom(U0,0,17,_,'

') , split(U0,[' '],L01) , L01 = [_,U1]) , replace(U1,'

','',U3) , split(U3,[''],L) , L = [U4|_] , replace_all(U4,'','',U5) , replace_all(U5,'','',U6) , replace_all(U6,'','',U7) , replace_all(U7,'','',U8) , replace_all(U8,'','',U9) , replace_all(U9,'','',U10) , replace_all(U10,'','',U11) , replace_all(U11,'','',U12) , replace_all(U12,'','',U13) , replace_all(U13,'','',U14) , replace_all(U14,'','',U)),Y) . % *** user: '千人万首' / 2 *** '千人万首'(_歌人,_歌ならび) :- '千人万首リンク情報'(_歌人,Host,File), '千人万首'(Host,File,_歌ならび), ! . % *** user: '千人万首' / 0 *** '千人万首' :- w3m('http://www.asahi-net.or.jp/~sg2h-ymst/yamatouta/sennin.html#a') . % *** user: '千人万首_member' / 2 *** '千人万首_member'(A,L) :- '千人万首_member_1'(A,L,R) . '千人万首_member'(A,L) :- '千人万首_member_1'(_,L,R), '千人万首_member'(A,R) . % *** user: '千人万首_member_1' / 3 *** '千人万首_member_1'(A,[A|R],R) :- '副文字列検索'(A,'

'), '副文字列検索'(A,'

') . '千人万首_member_1'(A,[A|R],R) :- '副文字列検索'(A,'

'), '副文字列検索'(A,'

') . '千人万首_member_1'(X,[A|R1],R) :- '副文字列検索'(A,'

'), \+('副文字列検索'(A,'

')), '千人万首_member_2'(X,[A|R1],R) . '千人万首_member_1'(X,[A|R1],R) :- '副文字列検索'(A,'

'), \+('副文字列検索'(A,'

')), '千人万首_member_2'(X,[A|R1],R) . '千人万首_member_1'(X,[A|R1],R) :- \+('副文字列検索'(A,'

')), \+('副文字列検索'(A,'

')), '千人万首_member_1'(X,R1,R) . % *** user: '千人万首_member_2' / 3 *** '千人万首_member_2'(X,[A,B|R1],R1) :- '副文字列検索'(B,'

'), concat_atom([A,B],X) . '千人万首_member_2'(X,[A,B|R1],R) :- \+('副文字列検索'(B,'

')), concat_atom([A,B],C), '千人万首_member_2'(X,[C|R1],R) . %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % *** user: replace_all / 4 *** replace_all('',A,B,'') :- ! . replace_all(String,S1,'',X) :- atom_chars(String,StringL), atom_chars(S1,S1L), replace_31(StringL,S1L,Y), concat_atom(Y,X), ! . replace_all(String,S1,S2,X) :- atom_chars(String,StringL), atom_chars(S1,S1L), atom_chars(S2,S2L), replace_41(StringL,S1L,S2L,Y), concat_atom(Y,X), ! . % *** user: replace_31 / 3 *** replace_31([],_,[]) :- ! . replace_31(L,L1,Y) :- append(L1,R,L), replace_31(R,L1,Y), ! . replace_31([A|R],L1,[A|R2]) :- replace_31(R,L1,R2) . % *** user: replace_41 / 4 *** replace_41([],_,_,[]) :- ! . replace_41(L,L1,L2,R2) :- append(L1,R,L), replace_41(R,L1,L2,R3), append(L2,R3,R2), ! . replace_41([A|R],L1,L2,[A|R2]) :- replace_41(R,L1,L2,R2) . % *** user: '副文字列検索' / 2 *** '副文字列検索'(_文字列,_副文字列) :- replace(_文字列,_副文字列,_副文字列,_), ! . % *** user: replace / 4 *** replace(String,S1,'',X) :- atom_chars(String,StringL), atom_chars(S1,S1L), replace_3(StringL,S1L,Y), concat_atom(Y,X), ! . replace(String,S1,S2,X) :- atom_chars(String,StringL), atom_chars(S1,S1L), atom_chars(S2,S2L), replace_4(StringL,S1L,S2L,Y), concat_atom(Y,X), ! . % *** user: replace_3 / 3 *** replace_3(L,L1,R) :- append(L1,R,L), ! . replace_3([A|R],L1,[A|R2]) :- replace_3(R,L1,R2) . % *** user: replace_4 / 4 *** replace_4(L,L1,L2,R2) :- append(L1,R,L), append(L2,R,R2), ! . replace_4([A|R],L1,L2,[A|R2]) :- replace_4(R,L1,L2,R2) . % *** user: http_client / 4 *** http_client(Host,File,Option_list,L) :- member(euc,Option_list), concat_atom(['w3c ','http://',Host,File],S), concat_atom(['/usr1/keizo/test/http-client -h ',Host,' -f ',File,' -p http'],S), shs(S,L1), http_client_2(Option_list,L1,L),!. http_client(Host,File,Option_list,L) :- member(sjis,Option_list), concat_atom(['w3c ','http://',Host,File,' | nkf -Se'],S), shs(S,L1), http_client_2(Option_list,L1,L). http_client_2(Option_list,L1,L) :- member('本文',Option_list), http_client_erase_header(L1,L),!. http_client_2(Option_list,L1,L) :- \+(member('本文',Option_list)), L1 = L,!. % *** user: http_client_erase_header / 2 *** http_client_erase_header([],[]) :- ! . http_client_erase_header([_,'\r'|R],R) :- ! . http_client_erase_header([_|R1],R) :- http_client_erase_header(R1,R) . % *** user: shs / 3 *** shs(Command,[],X) :- shs(Command,X), ! . shs(Command,List,X) :- tmpnam(TMPNAM), open(TMPNAM,write,Output1), wrln(Output1,List), close(Output1), concat_atom(['cat ',TMPNAM],Cat), system(Cat,user_input,Pipe), system(Command,Pipe,Output), findall(Y,(repeat , stream_reads(Output,Y) , (Y = end_of_file , (!) , fail ; true)),X), close(Pipe), close(Output), unlink(TMPNAM), ! . shs(Command,user_input,X) :- ( var(X) ; \+(var(X)), \+(X = pipe(_)) ), system(Command,user_input,Pipe), findall(S,(repeat , stream_reads(Pipe,S) , (S = end_of_file , (!) , fail ; true)),X), close(Pipe), ! . shs(Command,user_input,X) :- \+(var(X)), X = pipe(Pipe), system(Command,user_input,Pipe), ! . shs(Command,Input,Output) :- \+(var(Input)), Input = pipe(Pipe1), \+(var(Output)), Output = pipe(Pipe2), system(Command,Pipe1,Pipe2), close(Pipe1), ! . shs(Command,Input,X) :- \+(var(Input)), Input = pipe(Pipe1), ( var(X) ; \+(var(X)), \+(X = pipe(_)) ), system(Command,Pipe1,Pipe2), close(Pipe1), findall(S,(repeat , stream_reads(Pipe2,S) , (S = end_of_file , (!) , fail ; true)),X), close(Pipe2), ! . shs(Command,Input,X) :- \+(var(X)), X = pipe(Pipe), \+(var(Input)), \+(Input = pipe(_)), open(Input,read,InputStream), system(Command,InputStream,Pipe), close(InputStream), ! . shs(Command,Input,X) :- ( var(X) ; \+(var(X)), \+(X = pipe(_)) ), \+(var(Input)), \+(Input = pipe(_)), open(Input,read,InputStream), system(Command,InputStream,Pipe), close(InputStream), findall(S,(repeat , stream_reads(Pipe,S) , (S = end_of_file , (!) , fail ; true)),X), close(Pipe), ! . % *** user: shs / 2 *** shs(Command,X) :- \+(list(Command)), tmpnam(TMPNAM), open(TMPNAM,write,Output), system(Command,user_input,Output), close(Output), open(TMPNAM,read,Input), findall(S,(repeat , stream_reads(Input,S) , (S = end_of_file , (!) , fail ; true)),L), close(Input), unlink(TMPNAM), X = L, ! . shs(Command_list,X) :- list(Command_list), concat_atom(Command_list,' ',Command), shs(Command,X), ! . % *** user: shs / 1 *** shs(Command) :- \+(struct(Command)), shs(Command,X), lf(X) . shs(_). % *** user: w3c / 2 *** w3c(URL,File) :- atom(File), w3ctimeout(Timeout), concat_atom(['w3c -timeout ',Timeout,' -n "',URL,'"'],W3c), shs(W3c,X), open(File,write,Output), ( member(A,X), write_formatted(Output,'%t\n',[A]), fail ; close(Output) ), ! . w3c(URL,X) :- \+(atom(X)), w3ctimeout(Timeout), concat(['w3c -timeout ',Timeout,' -n "',URL,'"'],W3c), shs(W3c,X), ! . % *** user: w3c / 1 *** w3c(URL) :- concat_atom(['w3c -n "',URL,'"'],W3c), shs(W3c,X), ( member(A,X), wr('%t\n',[A]), fail ; true ), ! . % *** user: w3ctimeout / 1 *** w3ctimeout(60).