DouKaku? Language detail: Prolog

Prologです。

実行例:

?- fix(fact_maker, 10, X).
X = 3628800.

fix(F, A, R) :-
    call(F, call(fix, F), A, R).

fact_maker(_, 0, 1) :- !.
fact_maker(F, N, R) :-
    N1 is N - 1,
    call(F, N1, FN1),
    R is N * FN1.

急勾配の判定 (Nested Flatten)

1
2
3

sd([],_) :- !.
sd([X|Xs],S) :- X > S, S1 is S + X, sd(Xs,S1).
super_decreasing(Xs) :- reverse(Xs,Ys), sd(Ys,0).

'('と')'の対応 (Nested Flatten)

冗談です。 Prolog上にオブジェクト指向を乗せるとこれよりずっと重くなるからまあいいか。コピペにミスがあり、 {readfile ... } :- ... が抜けていました。追加します。

{pkd,[[],[],[]]} :- !.
{pkd,[[A|R1],R,Chars]} :-
    {char_code,[A,40]},
    {pekd,[R1,R2,Chars1]}
    {pkd,[R2,R,Chars2]},
    {append,[Chars1,Chars2,Chars]},!.
{pkd,[[A|R1],R,[A|R2]]} :-
    {pkd,[R1,R,R2]}.

{pekd,[[A|R],R,[]]} :-
    {char_code,[A,41]},!.
{pekd,[[A|R1],R,Chars]} :-
    {char_code,[A,40]},
    {pkd,[[A|R1],R2,Chars1]},
    {pekd,[R2,R,Chars2]},
    {append,[Chars1,Chars2,Chars]},!.
{pekd,[[A|R1],R,[A|R2]} :-
    {pekd,[R1,R,R2]}.

{readfile,[File,Chars]} :-
    {see,[File]},
    {get_char,[Char]},
    {readfile_2,[Char,Chars]},
    {seen,[]}.

{readfile_2,[end_of_file,[]]} :- !.
{readfile_2,[A,[A|R]} :-
    {get_char,[B]}
    {readfile_2,[B,R]}.

{odai,[File,Atom]} :-
    {readfile,[File,Chars]},
    {pkd,[Chars,_,Chars_2]},
    {atom_codes,[Atom,Chars_2]}.

{Functor,Args} :- Q =.. [Functor|Args],Q.

:- {odai,['foo.txt',Atom]}.

冗談です。

{pkd,[[],[],[]]} :- !.
{pkd,[[A|R1],R,Chars]} :-
    {char_code,[A,40]},
    {pekd,[R1,R2,Chars1]}
    {pkd,[R2,R,Chars2]},
    {append,[Chars1,Chars2,Chars]},!.
{pkd,[[A|R1],R,[A|R2]]} :-
    {pkd,[R1,R,R2]}.

{pekd,[[A|R],R,[]]} :-
    {char_code,[A,41]},!.
{pekd,[[A|R1],R,Chars]} :-
    {char_code,[A,40]},
    {pkd,[[A|R1],R2,Chars1]},
    {pekd,[R2,R,Chars2]},
    {append,[Chars1,Chars2,Chars]},!.
{pekd,[[A|R1],R,[A|R2]} :-
    {pekd,[R1,R,R2]}.

{readfile_2,[end_of_file,[]]} :- !.
{readfile_2,[A,[A|R]} :-
    {get_char,[B]}
    {readfile_2,[B,R]}.

{odai,[File,Atom]} :-
    {readfile,[File,Chars]},
    {pkd,[Chars,_,Chars_2]},
    {atom_codes,[Atom,Chars_2]}.

{Functor,Args} :- Q =.. [Functor|Args],Q.

:- {odai,['foo.txt',Atom]}.

漢数字で九九の表 (Nested Flatten)

言語指定を誤り、PrologでなくOtherにアラビア数字を削った訂正版を載せました。仕様を読み違えてました。

不細工なことになりました。 not(_)のあたり何とかならんかな.

漢数字(〇,[]).
漢数字(一,[_]).
漢数字(二,[_,_]).
漢数字(三,[_,_,_]).
漢数字(四,[_,_,_,_]).
漢数字(五,[_,_,_,_,_]).
漢数字(六,[_,_,_,_,_,_]).
漢数字(七,[_,_,_,_,_,_,_]).
漢数字(八,[_,_,_,_,_,_,_,_]).
漢数字(九,[_,_,_,_,_,_,_,_,_]).
九九 :-
   漢数字(A,L1),
   漢数字(B,L2),
   not(A=〇),
   not(B=〇),
   九九(L1,L2,[],[],X,Y),
   九九解表示(L2,X,Y),
   fail.
九九.

九九([],_,[],Y1,'　',Y) :- 漢数字(Y,Y1),!.
九九([],_,X1,Y1,X,Y) :- 漢数字(X,X1),漢数字(Y,Y1),!.
九九(L1,L2,L3,[_,_,_,_,_,_,_,_,_,_|R],X,Y) :-
    九九(L1,L2,[_|L3],R,X,Y),!.
九九([_|R1],L2,L3,L4,X,Y) :-
    append(L2,L4,L5),
    九九(R1,L2,L3,L5,X,Y).

九九解表示([_,_,_,_,_,_,_,_,_],X,Y) :-
   format('%t%t\n',[X,Y]),!.
九九解表示(_,X,Y) :-
   format('%t%t ',[X,Y]).

LL Golf Hole 8 - 横向きのピラミッドを作る (Nested Flatten)

?- \4.
*
**
***
****
***
**
*

\N:-1-N.
N-N:- +N.
L-N:- +L,M is L+1,M-N,+L.
+N:-writef('%r\n',[*,N]).

SWI-Prologで

1	p(N):-L is-N,between(L,N,X),K is N-abs(X),writef('%r\n',[*,K]),X=N.

九九の表示 (Nested Flatten)

writef と format の書式指定は全然違うんだなあ。

1 2	d(1). d(2). d(3). d(4). d(5). d(6). d(7). d(8). d(9). :-d(A),d(B),C is AB,\+writef('%d %d =%3r',[A,B,C]).

Hello, world!その２ (Nested Flatten)

1	writef([72,101,108,108,111,44,32,119,111,114,108,100,33]).

LL Golf Hole 5 - 最上位の桁を数え上げる (Nested Flatten)

SWI-Prologで。

count(N) :- writeln(0), sub_atom(N,1,_,_,Y), between(1,9,X), 
    atom_concat(X,Y,XY), writeln(XY), atom_number(XY,N), !.

:- count(300).

LL Golf Hole 4 - 文章から単語の索引を作る (Nested Flatten)

SWI-Prologで。大文字は小文字に変換しました。次のようにして、参照できます。
?- index('future', N).
N = 58 ;
N = 579.

:- use_module(library('http/http_open')).

assert_word(_, '') :- !.
assert_word(In, W) :- downcase_atom(W, WL), line_count(In, N), assert(index(WL, N)).

make_index(In, W) :- at_end_of_stream(In), assert_word(In, W), !.
make_index(In, W) :- peek_char(In, C), (char_type(C, csym) -> atom_concat(W, C, W1);
     assert_word(In, W), W1 = ''), get_char(In, _), make_index(In, W1).

:- http_open('http://www.gnu.org/licenses/gpl.txt', In, []), make_index(In, ''), close(In).

データの整列 (Nested Flatten)

辞書順の方は，組み込みで．距離の方は，距離-(X,Y)　のペアを作ってソート．

distance((X,Y), D) :- D is X * X + Y * Y.

distance_sort(L, S) :-
    map_list_to_pairs(distance, L, P),
    keysort(P, SP), pairs_values(SP, S).
    
:-  L = [(1,2), (3,4), (1,3), (2,4), (1,8)],
    msort(L, S1), writeln(S1),
    distance_sort(L, S2), writeln(S2).

総当たり戦の日程作成 (Nested Flatten)

日にちだけの入れ替えを除いて，全通り出力．並びが逆になってるので見づらいですが．
4 teams
[[2-3, 1-4], [2-4, 1-3], [3-4, 1-2]]
6 teams
[[4-5, 2-3, 1-6], [3-6, 2-4, 1-5], [3-5, 2-6, 1-4], [4-6, 2-5, 1-3], [5-6, 3-4, 1-2]]
[[4-5, 2-3, 1-6], [3-4, 2-6, 1-5], [3-6, 2-5, 1-4], [5-6, 2-4, 1-3], [4-6, 3-5, 1-2]]
[[3-5, 2-4, 1-6], [4-6, 2-3, 1-5], [3-6, 2-5, 1-4], [4-5, 2-6, 1-3], [5-6, 3-4, 1-2]]
[[3-4, 2-5, 1-6], [4-6, 2-3, 1-5], [3-5, 2-6, 1-4], [5-6, 2-4, 1-3], [4-5, 3-6, 1-2]]
[[3-5, 2-4, 1-6], [3-4, 2-6, 1-5], [5-6, 2-3, 1-4], [4-6, 2-5, 1-3], [4-5, 3-6, 1-2]]
[[3-4, 2-5, 1-6], [3-6, 2-4, 1-5], [5-6, 2-3, 1-4], [4-5, 2-6, 1-3], [4-6, 3-5, 1-2]]

match([_], []).
match([X|Xs], Ys) :-
    group_pairs_by_key(Y, [X-Xs]), append(Y, Y1, Ys), match(Xs, Y1).

game([], G, G).
game([X1-X2|Xs], Ys, G) :-
    append(Y1, [Y|Y2], Ys), \+ memberchk(Y, Y2),
    \+ memberchk(X1-_, Y), \+ memberchk(_-X1, Y),
    \+ memberchk(X2-_, Y), \+ memberchk(_-X2, Y),
    append(Y1, [[X1-X2|Y]|Y2], Z), game(Xs, Z, G).

round_robin(N, G) :- N mod 2 =:= 0,
    numlist(1, N, X), match(X, Y), N1 is N - 1,
    length(G0, N1), maplist(ord_empty, G0), game(Y, G0, G).

:-  writeln('4 teams'), forall(round_robin(4, G), writeln(G)),
    writeln('6 teams'), forall(round_robin(6, G), writeln(G)).

情報オリンピック2006年度国内本選問題4 (Nested Flatten)

トポロジカルソートを使用しました．

:- use_module(library(ugraphs)).

read_number(In, Num) :-
    read_line_to_codes(In, Codes), number_codes(Num, Codes).

read_number2(In, X-Y) :- read_line_to_codes(In, C),
    append(C1, [0' |C2], C), number_codes(X, C1), number_codes(Y, C2).

read_match(N, Match) :- current_input(In),
    read_number(In, N), read_number(In, M),
    length(Match, M), maplist(read_number2(In), Match).

write_rank(Rank, Extra) :-
    maplist(writeln, Rank), writeln(Extra).

single_solution([_], _).
single_solution([X1,X2|Xs], Match) :-
    memberchk(X1-X2, Match), single_solution([X2|Xs], Match).

rank(N, Match, Rank) :- 
    numlist(1, N, L), vertices_edges_to_ugraph(L, Match, G), top_sort(G, Rank).

:-  setup_and_call_cleanup(see('input.txt'), read_match(N, Match), seen), 
    rank(N, Match, Rank), (single_solution(Rank, Match) -> Extra = 0; Extra = 1),
    setup_and_call_cleanup(tell('output.txt'), write_rank(Rank, Extra), told).

文字変換表に基く文字列の変換 (Nested Flatten)

% 基本版
tr(_, _, [], []).
tr(A, B, [X|Xs], [Y|Ys]) :-
    (nth0(N, A, X) -> nth0(N, B, Y); Y = X), tr(A, B, Xs, Ys).

% 拡張版
tr2(A, B, X, Y) :- expand(A, A1), expand(B, B1), tr(A1, B1, X, Y).

expand([], []).
expand([X1,0'-,X2|Xs], Ys) :- !,
    numlist(X1, X2, L), append(L, L1, Ys), expand(Xs, L1).
expand([X|Xs], [X|Ys]) :- expand(Xs, Ys).

:- tr("qwertyuiop", "QWERTYUIOP", "typewriter", X1),
   string_to_list(S1, X1), writeln(S1),
   tr2("a-z", "A-Z", "typewriter", X2),
   string_to_list(S2, X2), writeln(S2).

ライフゲーム (Nested Flatten)

SWI-Prologで．間引きは実装してません．

in_range(X, L) :- Max is L - 1, between(0, Max, X).

surround((LX,LY), (X,Y), (X1,Y1), B) :-
    member((DX, DY), [(-1,-1),(0,-1),(1,-1),(-1,0),(1,0),(-1,1),(0,1),(1,1)]),
    X1 is (LX + X + DX) mod LX, Y1 is (LY + Y + DY) mod LY, member((X1,Y1), B).

live((LX,LY), (X,Y), B) :-
    in_range(X, LX), in_range(Y, LY),
    findall(T, surround((LX,LY), (X,Y), T, B), S),
    length(S, N), (member((X,Y), B) -> (N = 2; N = 3); (N = 3)).

print_board((LX, LY), B) :- 
    forall(in_range(Y, LY), (forall(in_range(X, LX),
        (member((X,Y), B) -> write('■'); write('□'))
    ), writeln(''))), writeln('').

lifegame(L, B) :-
    print_board(L, B), sleep(1),
    findall(X, live(L, X, B), B1), lifegame(L, B1).

init_board((LX,LY), (X,Y)) :- in_range(X, LX), in_range(Y, LY), random(10) < 3.

:- L= (10,10), findall(X, init_board(L, X), B), lifegame(L, B).

除算・余剰を使わずに閏年 (Nested Flatten)

まあ、かけ算でも出来るわけでして。
＃なんか揚げ足取りばっかしているように思われ
＃ちゃうだろうなぁ。マイナス評価でもしょうがないか。


$ pl -qs 124.pl
?- uru(1900).

No
?- uru(2000).

Yes
?- uru(2008).

Yes
?- uru(2100).

No
?-

uru(X):- divideby400(X).
uru(X):- divideby4(X), not(divideby100(X)).

divideby(X, Y, Z) :- 0 =:= X - integer(X * Y) * Z.
divideby4(X) :- divideby(X, 0.25, 4).
divideby100(X) :- divideby(X, 0.01, 100).
divideby400(X) :- divideby(X, 0.0025, 400).

1
2
3

leap(N) :- N < 0, N1 is N + 400, !, leap(N1).
leap(N) :- N >= 400, N1 is N - 400, !, leap(N1).
leap(N) :- N /\ 0b11 =:= 0b00, N \= 100, N \= 200, N \= 300.

ポーカーの役判定 (Nested Flatten)

permutationとパターンマッチで簡単に．効率は犠牲に．．．

pokerHand([X,X,X,X,X], R, 'Royal flush') :-
    permutation(R, ['T','J','Q','K','A']).

pokerHand([X,X,X,X,X], R, 'Straight flush') :-
    sub_atom('A23456789TJQK', _, 5, _, A),
    atom_chars(A, P), permutation(R, P).

pokerHand([X,X,X,X,X], _, 'Flush').

pokerHand(_, R, 'Straight') :-
    sub_atom('A23456789TJQKA', _, 5, _, A),
    atom_chars(A, P), permutation(R, P).

pokerHand(_, R, 'Four of a kind' ) :- permutation(R, [X,X,X,X,_]).
pokerHand(_, R, 'Full house'     ) :- permutation(R, [X,X,X,Y,Y]).
pokerHand(_, R, 'Three of a kind') :- permutation(R, [X,X,X,_,_]).
pokerHand(_, R, 'Two pair'       ) :- permutation(R, [X,X,Y,Y,_]).
pokerHand(_, R, 'One pair'       ) :- permutation(R, [X,X,_,_,_]).
pokerHand(_, _, 'No pair'        ).

poker(Card) :-
    atom_chars(Card, [S1,R1,S2,R2,S3,R3,S4,R4,S5,R5]),
    pokerHand([S1,S2,S3,S4,S5], [R1,R2,R3,R4,R5], H), !,
    writeln(H).

DouKaku?

Language detail: Prolog

Unsolved challenges

codes

Index

Feed

Other

Link

Pathtraq