オフラインリアルタイムどう書く E19 「カード当てゲーム」をPrologで解いた #どう書く

現場では惨敗でした。
Prolog で書けば綺麗に書けそうだなー、と思い書いてみました。たぶん 3 時間ぐらい。Prolog で書いたとしても負けてる。しかも寝る前に書いたので綺麗ぢゃない。

処理系は GNU-Prolog です。

問題とみなさんの解答はこちら → https://qiita.com/mtsmfm/items/67bf5c121ecbd9b5fab3

orde19.pro

% gprolog --consult-file orde19.pro --entry-goal 'main'

join([C], D) :- number_codes(C, D).
join([C|Cards], Acc) :- number_codes(C, D), append(D, [0',|Prev], Acc), join(Cards, Prev).

ordered_cards(N, Cards) :- findall(X, between(1, N, X), XS), findall(Y, between(1, N, Y), YS), append(XS, YS, S), msort(S, Cards).

cards_row([], _, _, _, []).
cards_row([0'x|Parities], N, Prev1, Prev1, [M|Cards]) :- P1_1 is Prev1 + 1, between(P1_1, N, M),  M mod 2 =:= 0, cards_row(Parities, N, Prev1, M, Cards).
cards_row([0'x|Parities], N, Prev0, Prev1, [M|Cards]) :- Prev0 < Prev1,     between(Prev1, N, M), M mod 2 =:= 0, cards_row(Parities, N, Prev1, M, Cards).
cards_row([0'o|Parities], N, Prev1, Prev1, [M|Cards]) :- P1_1 is Prev1 + 1, between(P1_1, N, M),  M mod 2 =:= 1, cards_row(Parities, N, Prev1, M, Cards).
cards_row([0'o|Parities], N, Prev0, Prev1, [M|Cards]) :- Prev0 < Prev1,     between(Prev1, N, M), M mod 2 =:= 1, cards_row(Parities, N, Prev1, M, Cards).
cards_row(Parities, N, Cards) :- cards_row(Parities, N, 0, 0, Cards).

solve(N, UpperParities, LowerParities, OrderedCards, Result) :-
  cards_row(UpperParities, N, UpperCards),
  cards_row(LowerParities, N, LowerCards),
  append(UpperCards, LowerCards, AllCards),
  join(AllCards, Result),
  msort(AllCards, OrderedCards).

join_results([R], R).
join_results([R|Rs], Acc) :- append(R, [0'||Prev], Acc), join_results(Rs, Prev).

solve(Input, Result) :-
  append(UpperParities, [0',|LowerParities], Input),
  length(UpperParities, N),
  ordered_cards(N, OrderedCards),
  findall(R, solve(N, UpperParities, LowerParities, OrderedCards, R), Rs),
  join_results(Rs, Result).

judge(Input, Expected, Expected) :-
  format("\x1b\[32mpassed  input: ~s\x1b\[0m~n", [Input]), !.
judge(Input, Expected, Actual) :-
  format("\x1b\[31mfailed  input: ~s, expected: ~s, actual: ~s\x1b\[0m~n", [Input, Expected, Actual]), !.

test(Input, Expected) :-
  solve(Input, Actual),
  judge(Input, Expected, Actual).

main :-
  test("xxoxo,oooxo", "2,2,3,4,5,1,1,3,4,5"),
  test("ooxxo,ooxxo", "1,1,2,2,5,3,3,4,4,5|3,3,4,4,5,1,1,2,2,5"),
  test("oxoxo,oxoxo", "1,2,3,4,5,1,2,3,4,5"),
  test("ooxoxx,oxxoxo", "1,3,4,5,6,6,1,2,2,3,4,5"),
  test("ooxxxx,ooxxoo", "1,1,2,2,6,6,3,3,4,4,5,5|3,3,4,4,6,6,1,1,2,2,5,5"),
  test("oxoxox,oxoxox", "1,2,3,4,5,6,1,2,3,4,5,6"),
  test("oxoxxxo,oxoxooo", "1,2,3,4,6,6,7,1,2,3,4,5,5,7"),
  test("oxooxxx,oxxoooo", "1,2,3,3,4,6,6,1,2,4,5,5,7,7"),
  test("oxoxxxo,oxoooxo", "1,2,3,4,4,6,7,1,2,3,5,5,6,7"),
  test("oxoxooox,oxoxoxxx", "1,2,3,4,5,7,7,8,1,2,3,4,5,6,6,8"),
  test("ooxoxxox,ooxxxoox", "3,3,4,5,6,6,7,8,1,1,2,2,4,5,7,8"),
  test("oxoxxxxx,oxoxoooo", "1,2,3,4,6,6,8,8,1,2,3,4,5,5,7,7"),
  test("oxoxooxxo,oxooxxoxo", "1,2,5,6,7,7,8,8,9,1,2,3,3,4,4,5,6,9"),
  test("oxoooooxo,oxxxoxxxo", "1,2,3,3,5,7,7,8,9,1,2,4,4,5,6,6,8,9"),
  test("oxoxoxxox,oxoxooxoo", "1,2,3,4,5,6,6,7,8,1,2,3,4,5,7,8,9,9"),
  test("oooxxxxoxo,xxooooxoxx", "1,1,3,4,4,6,6,7,8,9,2,2,3,5,5,7,8,9,10,10"),
  test("ooooxxxoxx,xxooxxxooo", "1,1,5,5,6,8,8,9,10,10,2,2,3,3,4,4,6,7,7,9"),
  test("xoxxoxxoxo,ooxoooxoxx", "2,3,4,4,5,6,6,7,8,9,1,1,2,3,5,7,8,9,10,10"),
  test("oxooxxoooxo,oxxxoxooxxo", "1,2,3,3,4,4,5,5,7,8,11,1,2,6,6,7,8,9,9,10,10,11"),
  test("oooxxxxoxoo,xxooooxooxx", "1,1,3,4,4,6,6,7,8,11,11,2,2,3,5,5,7,8,9,9,10,10"),
  test("ooooxxoxoxo,oxxxxooxoxo", "1,3,3,5,6,6,7,8,9,10,11,1,2,2,4,4,5,7,8,9,10,11"),
  test("ooooxoxooxox,xxoxxoxoxxox", "1,1,3,5,6,7,8,9,9,10,11,12,2,2,3,4,4,5,6,7,8,10,11,12"),
  test("ooxxoooooxox,ooxxoxxxxxox", "1,1,2,2,5,7,7,9,9,10,11,12,3,3,4,4,5,6,6,8,8,10,11,12|3,3,4,4,5,7,7,9,9,10,11,12,1,1,2,2,5,6,6,8,8,10,11,12"),
  test("xoxoxxooxoxx,ooxoxoxooxxo", "2,3,4,5,6,6,7,7,8,11,12,12,1,1,2,3,4,5,8,9,9,10,10,11|2,3,4,5,6,8,9,9,10,11,12,12,1,1,2,3,4,5,6,7,7,8,10,11"),
  test("oooooooooooo,xxxxxxxxxxxx", "1,1,3,3,5,5,7,7,9,9,11,11,2,2,4,4,6,6,8,8,10,10,12,12"),
  halt.

私のマシンでこれぐらい。そこそこの早さは出ました。

$ time gprolog --consult-file orde19.pro --entry-goal 'main'
GNU Prolog 1.4.4 (64 bits)
Compiled Jan  7 2016, 21:03:39 with clang
By Daniel Diaz
Copyright (C) 1999-2013 Daniel Diaz

...中略...

passed  input: xoxoxxooxoxx,ooxoxoxooxxo
passed  input: oooooooooooo,xxxxxxxxxxxx

real    0m0.144s
user    0m0.129s
sys     0m0.008s

2017/11/05 08:12 追記

とっちらかっていた部分を整理して、コメントつけました。
順番入れ替えたり名前を変えたりしていますが、ほぼ同じものです。

% gprolog --consult-file orde19.pro --entry-goal 'main'

% 数値を文字列に変換してコンマで連結する
join_comma([C], D) :-
  number_codes(C, D).
join_comma([C|Cards], Acc) :-
  number_codes(C, D),
  append(D, [0',|Prev], Acc),
  join_comma(Cards, Prev).

% 文字列をパイプ (|) で連結する
join_pipe([R], R).
join_pipe([R|Rs], Acc) :-
  append(R, [0'||Prev], Acc),
  join_pipe(Rs, Prev).

% 各 2 つずつ出現しソートされた数値列
reference_cards(Length, Cards) :-
  findall(X, between(1, Length, X), XS),
  append(XS, XS, S),
  msort(S, Cards).

% 入力の文字列と 2 の剰余
paritychar_rest(0'x, 0).
paritychar_rest(0'o, 1).

% 記号列に合う数値の並び列を生成する
% card_sequence(全体の長さ, 偶奇を表す文字列, 2 つ前の数値, 1 つ前の数値, 数値の並び)
card_sequence(_, [], _, _, []).
card_sequence(Length, [P|Parities], Prev, Prev, [C|Cards]) :- % 直前二つの数値が同じ場合
  succ(Prev, Prev1),
  paritychar_rest(P, R),
  between(Prev1, Length, C),                                  % 直前の値 より大きく、長さ以下の値を選ぶ
  C mod 2 =:= R,
  card_sequence(Length, Parities, Prev, C, Cards).
card_sequence(Length, [P|Parities], Prev0, Prev1, [C|Cards]) :- % 直前二つの数値が異なる場合
  Prev0 < Prev1,
  paritychar_rest(P, R),
  between(Prev1, Length, C),                                    % 直前の値以上、長さ以下の値を選ぶ
  C mod 2 =:= R,
  card_sequence(Length, Parities, Prev1, C, Cards).
card_sequence(Length, Parities, Cards) :-
  card_sequence(Length, Parities, 0, 0, Cards).

% 上下の記号列に合う数値の並び列を生成する
lineup(Length, UpperParities, LowerParities, ReferenceCards, Result) :-
  card_sequence(Length, UpperParities, UpperCards), % 上段の数値の並び
  card_sequence(Length, LowerParities, LowerCards), % 下段の数値の並び
  append(UpperCards, LowerCards, AllCards),         % 上下段を連結
  msort(AllCards, ReferenceCards),                  % ソートしたものがリファレンスと一致する
  join_comma(AllCards, Result).                     % 文字列に変換してコンマで連結する

solve(Input, Result) :-
  append(UpperParities, [0',|LowerParities], Input), % コンマで分割
  length(UpperParities, Length),                     % 長さ
  reference_cards(Length, ReferenceCards),           % ソートした場合に得られる数値列
  findall(R, lineup(Length, UpperParities, LowerParities, ReferenceCards, R), Rs), % 正答をすべて集める
  join_pipe(Rs, Result).                             % パイプ (|) で連結する

judge(Input, Expected, Expected) :-
  format("\x1b\[32mpassed  input: ~s\x1b\[0m~n", [Input]), !.
judge(Input, Expected, Actual) :-
  format("\x1b\[31mfailed  input: ~s, expected: ~s, actual: ~s\x1b\[0m~n", [Input, Expected, Actual]), !.

test(Input, Expected) :-
  solve(Input, Actual),
  judge(Input, Expected, Actual).

main :-
  test("xxoxo,oooxo", "2,2,3,4,5,1,1,3,4,5"),
  % 略
  halt.