オフラインリアルタイムどう書く E30 「面白いセルの合計」を Prolog で解いた

orde30.prolog

% オフラインリアルタイムどう書く E30 「面白いセルの合計」を Prolog で解いた
%   http://nabetani.sakura.ne.jp/hena/orde30sumt/
%
% 述語 memo/3 を動的に定義することで memoization を実現しています
%
% 処理系:
%   GNU Prolog (http://www.gprolog.org)
%
% コンパイル:
%   $ gplc --no-top-level orde30.prolog
%
% 実行:
%   $ ./orde30

:- initialization(main). % エントリポイントを指定する
:- dynamic(memo/3). % 動的に定義する述語を指定する

% split/2 文字列をコンマで分割し数値のリストにする
% 第一引数: 数値のリスト
% 第二引数: コンマ区切りの数値の並びの文字列
split([Value | Values], S) :-
  append(S1, [0', | S2], S),
  number_codes(Value, S1),
  split(Values, S2),
  !.
split([Value], S) :-
  number_codes(Value, S),
  !.

% interest/2 第一引数のリストの数値のうち、面白い値のみ第二引数のリストに集める
interest([_, _], []) :- !.
interest([C, C, C | CS], IS) :- interest([C, C | CS], IS), !.
interest([_, C | CS], [C | IS]) :- interest([C | CS], IS), !.

% calc/3 セルの値を計算する
% 第一引数: 長さの列（下位から上位の順）
% 第二引数: 注目する位置（左端の位置を 0 に補正したもの）
% 第三引数: セルの値

calc([_], T, 0) :-                            % 最上段で注目する位置が範囲外であれば、セルの値を 0 にする
  T < 0,
  !.
calc([_], T, R) :-                            % 最上段で注目する位置が範囲内であれば、セルの値を 位置 + 1 にする
  R is T + 1,                                 % （左端を 0 にしているのでその分を戻す）
  !.
calc(LS, T, R) :-                             % メモした値があればそれをセルの値にする
  memo(LS, T, R),
  !.
calc([L1, L2 | LS], T, R) :-                  % 地道に計算する
  Left is (L1 * T) div L2 - 1,                % 計算に必要な上段のセルの左端の位置
  Right is (L1 * (T + 1) - 1) div L2 + 1,     % 計算に必要な上段のセルの右端の位置
  findall(                                    % 計算に必要な上段の各セルの値を求める
    C,
    (
      between(Left, Right, N),
      calc([L2 | LS], N, C)
    ),
    CS
  ),
  interest(CS, IS),                           % 面白い値のみ集める
  sum_list(IS, SUM),                          % 集めた面白い数を足し合わせる
  R is SUM mod 1000,                          % 1000 の剰余を取る
  asserta((memo([L1, L2 | LS], T, R) :- !)),  % 今回の値の組合せの述語 memo/3 を定義する
  !.

% solve/2 問題を解く
solve(Input, Result) :-
  retractall(memo(_, _, _)),                    % 前回メモした memo/3 の定義を取り消す
  append(LengthsStr, [0'/ | TargetStr], Input), % セル幅の文字列と注目セルの位置の文字列に分離する
  number_codes(Target, TargetStr),              % 注目セルの位置を数値にする
  split(Lengths, LengthsStr),                   % セル幅の文字列を数値のリストにする
  Target1 is Target - 1,                        % 位置を 0 始まりに補正する
  reverse(Lengths, ReversedLengths),            % 下段から上段の順に処理するため、順序を逆にする
  calc(ReversedLengths, Target1, Value),        % 注目セルの値を計算する
  number_codes(Value, Result).                  % 数値を文字列にする

% judge/4 判定結果を出力する
judge(Number, _, E, E) :-
  format("~d passed~n", [Number]),
  !.
judge(Number, Input, Expected, Actual) :-
  format("~d failed  input: ~s / expected: ~s / actual: ~s~n", [Number, Input, Expected, Actual]),
  !.

% test/3 テストする
test(Number, Input, Expected) :-
  solve(Input, Actual),
  judge(Number, Input, Expected, Actual).

% main/0 エントリポイント
main :-
  test(0, "4,6,1,5/3", "14"),
  test(1, "1/1", "1"),
  test(2, "6/1", "1"),
  test(3, "4,6/3", "9"),
  test(4, "68/68", "68"),
  test(5, "360/10", "10"),
  test(6, "2,7,8/8", "256"),
  test(7, "37,88/71", "504"),
  test(8, "5,4,1,4/6", "10"),
  test(9, "123/4567", "4567"),
  test(10, "473,601/397", "9"),
  test(11, "47,89,82/38", "402"),
  test(12, "4,8,1,2,10/10", "98"),
  test(13, "5,6,7,9,5,2/5", "48"),
  test(14, "538,846,73/778", "213"),
  test(15, "80,48,65,83/100", "830"),
  test(16, "1,4,6,10,5,7,5/5", "904"),
  test(17, "10,4,1,6,1,2,3,5/3", "9"),
  test(18, "3,1,4,1,5,9,2/14", "385"),
  test(19, "33,32,75,24,36/76", "491"),
  test(20, "43,59,32,2,66,42/58", "849"),
  test(21, "985,178,756,798/660", "675"),
  test(22, "3,4,3,4,5,2,3,10,2/5", "334"),
  test(23, "9,3,4,3,1,9,4,9,3,9/5", "516"),
  test(24, "883,184,29,803,129/129", "154"),
  test(25, "4,77,53,79,16,21,100/59", "690"),
  test(26, "49,94,4,99,43,78,22,74/1", "282"),
  test(27, "292,871,120,780,431,83/92", "396"),
  test(28, "4,2,9,1,5,10,7,6,8,9,10/3", "234"),
  test(29, "9,5,7,6,9,3,4,10,8,6,4,5/6", "990"),
  test(30, "11,87,44,12,3,52,81,33,55/1", "384"),
  test(31, "9,2,6,9,5,1,3,6,1,9,2,1,4/9", "498"),
  test(32, "68,62,15,97,5,68,12,87,78,76/57", "751"),
  test(33, "792,720,910,374,854,561,306/582", "731"),
  test(34, "5,10,1,7,5,3,5,7,4,8,9,6,1,9,6/5", "768"),
  test(35, "7,2,7,8,3,4,2,10,6,10,3,1,10,2/10", "120"),
  test(36, "4,2,10,7,8,9,8,1,9,7,9,10,9,4,7,2/8", "40"),
  test(37, "41,55,80,12,39,94,2,96,45,89,25/68", "152"),
  test(38, "907,371,556,955,384,24,700,131/378", "600"),
  test(39, "30,68,36,40,10,74,42,24,4,47,91,51/4", "180"),
  test(40, "807,276,175,555,372,185,445,489,590/287", "80"),
  test(41, "92,41,37,49,26,68,36,31,30,34,19,18,94/85", "626"),
  test(42, "529,153,926,150,111,26,465,957,890,887/118", "114"),
  test(43, "59,1,87,64,17,37,95,25,64,68,52,9,57,92/94", "998"),
  test(44, "979,772,235,717,999,292,727,702,710,728,556/33", "912"),
  test(45, "40,93,46,27,75,53,50,92,52,100,19,35,52,31,54/59", "512"),
  test(46, "800,778,395,540,430,200,424,62,342,866,45,803/931", "260"),
  test(47, "85,90,67,61,17,57,24,25,5,50,88,31,55,26,21,98/58", "884"),
  test(48, "510,515,70,358,909,557,886,766,323,624,92,342,424/552", "238"),
  test(49, "892,751,88,161,148,585,456,88,14,315,594,121,885,952/833", "700"),
  test(50, "940,824,509,787,942,856,450,327,491,54,817,95,60,337,667/637", "206"),
  test(51, "408,412,30,930,372,822,632,948,855,503,8,618,138,695,897,852/377", "212"),
  !.