DouKaku?

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

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

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).

:- 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).

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).

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)).

:- 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).

% 基本版
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).

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).

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).

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.

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).

straight([(_,A)|As]):-seq(A,As).

seq(_,[]).
seq(P,[(_,N)|Ns]):-succ(P,N),seq(N,Ns).

flush([(A,_)|As]):-flush0(A,As).
flush0(_,[]).
flush0(A,[(A,_)|As]):-flush0(A,As).

count([],[]).
count([(_,N)|Ns],R):-count(Ns,Rs),countw(N,Rs,R).

countw(N,[],[(N,1)]).
countw(N,[(N,C0)|R],[(N,C)|R]):-succ(C0,C).
countw(N,[P|R0],[P|R]):-countw(N,R0,R).

sortcard(C,Cs):-predsort(cmp,C,Cs).
cmp(>,(_,N1),(_,N2)):-N1>N2,!.
cmp(<,_,_):-!.

p([(S,1),(S,10),(S,11),(S,12),(S,13)],'Royal flush'):-!.
p(C, 'Straight flush'):-straight(C),flush(C),!.
p(C, 'Flush'):-flush(C),!.
p(C, 'Straight'):-straight(C),!.
p(C, R) :- count(C,C1), maplist(arg(2),C1,C2),msort(C2,C3),n(C3, R).
p(_, 'No Pair').

n([2,3],'Full house'):-!.
n([1,4],'four of a kind'):-!.
n([1,1,3],'Three of a kind'):-!.
n([1,2,2],'Two pair'):-!.
n([1,1,1,2],'One pair'):-!.

tcard1([],[]).
tcard1([S,Na|Cs],[(S,N)|Cs1]):-nth1(N,[a,'2','3','4','5','6','7','8','9',t,j,q,k],Na),tcard1(Cs,Cs1).

poker(C,R):-atom_chars(C,Cs),tcard1(Cs,R0),sortcard(R0,R1),p(R1,R),!.

test(C):-poker(C,R),write(C->R),nl.

:-maplist(test,[sqsjsaskst,
                d9d7d6d5d8,
                c2d2s2h3h2,
                c2d3s2h3h2,
                s9s4s8stsj,
                c4h7d5s6h3,
                s6h6c5dqc6,
                s6hqc5dqc6,
                s6h4c5dqc6,
                sjsqsksac2]).

:-dynamic(ca/2).

even(N):- 1 =:= N /\ 1.

c(1,0):-!.
c(N,R):-ca(N,R),!.
c(N,R) :-!, (even(N)->N1 is N * 3 + 1; N1 is N / 2),
            c(N1,R0),
            succ(R0,R),
            asserta(ca(N,R)).

max_c(M,M,MaxI,MaxF,(MaxI,MaxF)).
max_c(I,M,MaxI,MaxF,R):-!,
        c(I,F),
        succ(I,I1),
        (MaxF < F -> max_c(I1,M,I,F,R)
                   ; max_c(I1,M,MaxI,MaxF,R)).

max_c(M,R):-max_c(1,M,0,0,R).

:-N is integer(2^20) + 1, max_c(N,R), write(R), nl, halt.

maho(N,R):-SS is integer(N ^ 2),
           S is integer((SS + 1) * SS / 2 / N),
           seq(SS,Lx),
           reverse(Lx,Lxx),
           C=c(0),
           (gen(N,S,Lxx,_,_),
            countup(C),
            fail
           ;C=c(R)).

countup(C):-arg(1,C,N0),succ(N0,N1),nb_setarg(1,C,N1).

gen_list(1,V,[1],[V]).
gen_list(X,V,[0|L],[0|T]):-
        succ(X1,X),
        gen_list(X1,V,L,T).

gen(N,_,[V],L,T):-!,
        gen_list(N,V,L,T).
gen(N,S,[I|Is],L,T):-
        gen(N,S,Is,Ls,T0),
        addH(N,S,Ls,T0,I,L,T).

addH(_,_,[],_,_,_):-fail.
addH(N,S,[L|Ls],[T|Ts],I,[L1|Ls],[T1|Ts]):-
        Ls\=[0|_],
        L1 is L + 1,
        T1 is T + I,
        (L1=N,S=T1;T1<S,L1<N).
addH(N,S,[L|Ls],[T|Ts],I,[L|Lss],[T|Tss]):-
        addH(N,S,Ls,Ts,I,Lss,Tss).

seq(0,[]).
seq(N,[N|L]):-
        succ(N1,N),
        seq(N1,L).

:-maho(5,C),write(C),nl,halt.

?- X is 0b01101001, Y is 2'01101001.
X = 105,
Y = 105

switch(['|'], [A], [A]).
switch(['|','-','|'|S], [A,' ',B|L], [B,' ',C|L1]) :-
    switch(['|'|S], [A|L], [C|L1]).
switch(['|',' ','|'|S], [A,' ',B|L], [A,' ',C|L1]) :-
    switch(['|'|S], [B|L], [C|L1]).

amida_sub(Hs, []) :- atom_chars(H, Hs), writeln(H).
amida_sub(Hs, [X|L]) :- writeln(X), atom_chars(X, Xs),
    switch(Xs, Hs, H1), amida_sub(H1, L).

amida(A) :- concat_atom([H|L], '\n', A), writeln(H),
    atom_chars(H, Hs), amida_sub(Hs, L).

:- amida('A B C D E
| | |-| |
|-| | |-|
| |-| |-|
|-| |-| |
|-| | | |').

komati([X], N, X) :- term_to_atom(T, X), N =:= T.
komati([X1,X2|Xs], N, S) :- member(Op, [+,-,*,/,'']),
    concat_atom([X1,Op,X2], X3), komati([X3|Xs], N, S).

:- forall(komati([1,2,3,4,5,6,7,8,9], 100, S), writeln(S)).

splitLine(S, L) :- append(S1, [10|S2], S),
    splitLine(S1, L1), splitLine(S2, L2), append(L1, L2, L), !.
splitLine(S, [S]).

find(_, [], _, _, _, _).
find(Text, [C|S], DX, DY, X, Y) :- nth0(Y, Text, Line), nth0(X, Line, C),
    X1 is X + DX, Y1 is Y + DY, find(Text, S, DX, DY, X1, Y1).

find8(Text, Word) :-
    splitLine(Text, Lines),
    forall((member([DX, DY, S],
    [[0, -1, '上'], [ 1, -1, '右上'], [ 1, 0, '右'], [ 1,  1, '右下'],
     [0,  1, '下'], [-1,  1, '左下'], [-1, 0, '左'], [-1, -1, '左上']]),
    find(Lines, Word,  DX, DY, X, Y)), format('(~d, ~d), ~p~n', [X, Y, S])).

:- find8("リオウウリウ
ウオリウオリ
オリリオリウ
リリオオウオ", "ウオリ").

partNum(N, 1, [N]).
partNum(N, M, [J|L]) :- M > 1, M1 is M - 1,
    between(0, N, I), J is N - I, partNum(I, M1, L).

:- forall((partNum(5, 3, L), concat_atom(L, ', ', X)), writeln(X)).