2021年逆にPrologでAtCoderをやる
先駆者様たち
経緯
いやほんと, 知らんうちに Prolog（SWI-Prolog）が AtCoder で使えるようになっており. Prolog はその言語の性質上, 全探索をしてしまうようなアルゴリズムと相性が良い.また, 単純なパターンマッチをするだけといったものも書きやすい. 残念ながら計算速度の観点から, 全ての問題を Prolog で解くのは無理だと思うのだが, ABC の A問題や B問題くらいなら大抵解けるし, Prolog の恩恵を受ける問題もあると思った.
テンプレート, 入出力など
競技プログラミングの文脈でテンプレートというのは, あまりにもよく使うので問題を解く前から予め関数をいくつか定義しておいたりした状態のボイラープレートとしてのソースコードのことを言う. 特に競技プログラミングは入出力に標準入力・標準出力を使い, その形式も多少癖がある.そして Prolog は必ずしても適していないため, 自分で便利に使える入出力用の述語を定義しておく.
暫定版として, 次が私のテンプレートである.
main :- % ここにコードを書く writeln(Ans). % stdio get_string(String) :- read_string(current_input, ' \n', '', _, String). get_chars(Chars) :- get_string(String), string_chars(String, Chars). get_atom(Atom) :- get_string(String), atom_string(Atom, String). get_number(Number) :- get_string(String), number_string(Number, String). get_numbers(0, []). get_numbers(N, [X|Xs]) :- get_number(X), N1 is N - 1, get_numbers(N1, Xs). % math even(X) :- X mod 2 =:= 0. odd(X) :- X mod 2 =:= 1. % list head([X|_], X). tail([_|Xs], Xs). last([X], X). last([_|Xs], Z) :- last(Xs, Z). take(0, _, []). take(_, [], []). take(Length, [X|Xs], Prefix) :- M is Length - 1, take(M, Xs, Ps), Prefix = [X|Ps]. minimum([X], X). minimum([X|Xs], Z) :- minimum(Xs, U), Z is min(X, U). maximum([X], X). maximum([X|Xs], Z) :- maximum(Xs, U), Z is max(X, U). sum([], 0). sum([X|Xs], S) :- sum(Xs, T), S is X + T. contain([X|_], X). contain([_|Xs], X) :- contain(Xs, X). nth([X|_], 1, X). nth([_|Xs], K, Ans) :- K1 is K - 1, nth(Xs, K1, Ans). count([], _, 0). count([X|Rest], X, N) :- !, count(Rest, X, M), N is M + 1. count([_|Rest], X, N) :- count(Rest, X, N).
頭の方にある % ここにコードを書く の部分を埋めて提出する.
% stdio に続くブロックに入力周りを書いてある.この定義は先駆者様たちのコードを多いに参考にしている.出力する述語は組み込みの write または writeln で事足りているので自分で定義はしていない.
それより後ろには汎用的と思われる述語をいくつか自分で定義している.のだが, SWI-Prolog に詳しくないので, 実は組み込みの述語で十分だったりして, いくつか不要な可能性もある.逆に今後増えてく可能性は多いにある.
精選 10 問
先駆者様のN番煎じになるので恐縮だがさっと解いてこう.
コードを載せてくが, テンプレートで定義した述語はその定義を省略し, main と追加で定義した述語の定義だけ書く.
ABC086A - Product
main :- get_number(A), get_number(B), get_number(C), get_string(S), Sum is A + B + C, writeln(Sum), writeln(S).
自前で定義した入力を受け取る get_* はスペースと改行を区切り文字としてあるので, 勝手にトークナイズされて気にする必要はない.
PracticeA - Welcome to AtCoder
main :- get_number(X), get_number(Y), (even(X * Y) -> write("Even"); write("Odd")), nl.
(A -> B; C) は A という述語が成り立つなら B を評価し, さもなくば C を評価する.
いわゆる If 文として使うことができる.
外側の () は必ずしも必要ではないが, あったほうが良い.
最後の nl は改行文字を出力するだけの述語.
上では If 文の結果で答えを出力させており, いかにも手続きプログラミングといった味付けだ.
次のように答えの文字列を直接得るための述語 solve を別途用意する方が Prolog の趣があるかもしれない.
main :- get_number(X), get_number(Y), solve(X, Y, Ans), writeln(Ans). % Ans を出力して改行 solve(X, Y, "Even") :- even(X * Y). solve(_, _, "Odd").
ABC081A - Placing Marbles
与えられるのは数値だが, 文字列として処理したいので初めから文字列として受け取る.
get_chars は char のリストを返す.
このリストが '1' を含む個数を求める.
main :- get_chars(S), count_one(S, Ans), writeln(Ans). count_one([], 0). count_one(['1' | Xs], N) :- count_one(Xs, M), N is M + 1. count_one(['0' | Xs], N) :- count_one(Xs, N).
ABC081B - Shift only
main :- get_number(N), get_numbers(N, As), solve(As, Ans), writeln(Ans). solve([A], Ans) :- halven_times(A, Ans). solve([A|As], Ans) :- halven_times(A, X), solve(As, Y), Ans is min(X, Y). halven_times(X, 0) :- odd(X). halven_times(X, M) :- even(X), X2 is X // 2, halven_times(X2, M1), M is M1 + 1.
get_numbers は個数を指定して, その長さの列を読み取って返す.
solve はこのリストの各値に halven_times を適用してその最小値を返してる.
halven_times は一つの整数を最大何回 2 で割り算できるかを求めている.
ABC087B - Coins
ようやく Prolog らしい問題だ.
３つの自然数 A B C について全探索をし, ある性質が成り立つものの通り数を求めたい.
これをするには, その成り立って欲しい性質を述語として定義し, findall という述語にそれを渡せば,
成り立つもの全てがリストとして返ってくる.
ここではそのリストの長さが答えだ.
main :- get_number(A), get_number(B), get_number(C), get_number(X), findall(_, solve(A, B, C, X), Rs), length(Rs, Ans), write(Ans), nl. solve(A, B, C, X) :- between(0, A, I), between(0, B, J), between(0, C, K), 500 * I + 100 * J + 50 * K =:= X.
findall の結果がリスト Rs として返ってくる.
第一引数には何に関するリストを求めたいかを指定するのだが, ここでは中身は興味が無いので _ としてある.
=:= は両辺を式として評価した結果についての等号.
ABC083B - Some Sums
一つの整数について, 各桁の和を求めるような述語を一つ定義する.
この定義自体はつまらなく再帰関数のノリで計算させればよい.
これが満たすべき条件を定義したら, やはり findall に入れることで, 成り立つもの全てを集めることができる.
さっきの問題では _ とした第一引数にそのことを入れるのである.
main :- get_number(N), get_number(A), get_number(B), findall(X, solve(N, A, B, X), Rs), % solve を満たす全ての X を集めたものがリスト Rs. sum_list(Rs, Ans), write(Ans), nl. % X が条件を満たす? solve(N, A, B, X) :- between(1, N, X), sum_of_digits(X, S), between(A, B, S). % X の各桁の和が S. sum_of_digits(X, S) :- X < 10, S is X. sum_of_digits(X, S) :- X >= 10, Head is X // 10, Tail is X mod 10, sum_of_digits(Head, T), S is T + Tail.
ABC088B - Card Game for Two
解放だが, 列を降順にソートしたら先頭から交互に取り合えば良い.
というわけでソートをする必要がある.
知っておくべき組み込みのソートとして sort と msort がある.
ただの昇順ソートは msort で良い（msort の m は merge sort の m?）.
reverse でそれをさらにひっくり返せばほしかった降順ソートになるが, sort は比較演算子を直接渡せる.
ちなみに @> を渡すと, 重複する値が勝手に消されるので注意.
main :- get_number(N), get_numbers(N, A), sort(0, @>=, A, B), % 比較に使うキー, 比較演算, ソート前, ソート後 solve(B, Ans), writeln(Ans). solve([], 0). solve([X], X). solve([X|Xs], D) :- solve(Xs, E), D is X - E.
ABC085B - Kagami Mochi
列の内, 異なる値はいくつあるかという問題.
sort に @< や @> を渡すと重複する値を消してくれることを利用すると, これがさくっと実現できる.
main :- get_number(N), get_numbers(N, A), sort(0, @<, A, B), length(B, Ans), write(Ans), nl.
ABC085C - Otoshidama
これもつまらない全探索.
ある条件を満たすものが一つでもあればその解を出力する.
(-> ;) を使えばよい.
main :- get_number(N), get_number(Y), solve(N, Y, A, B, C) -> ( % 満たす A,B,C があるならそれを出力 writeln(A), writeln(B), writeln(C) ); writeln("-1 -1 -1"). solve(N, Y, A, B, C) :- between(0, N, A), NA is N - A, between(0, NA, B), C is N - A - B, 10000 * A + 5000 * B + 1000 * C =:= Y.
ABC049C - Daydream
こんなもん完璧に Prolog のためにあるような問題で, 問題文を実直にコードに翻訳すると勝手に処理系が解いてくれる.
main :- get_chars(S), (ok(S) -> writeln("YES"); writeln("NO")). ok([]). ok([d,r,e,a,m | Rest]) :- ok(Rest). ok([d,r,e,a,m,e,r | Rest]) :- ok(Rest). ok([e,r,a,s,e | Rest]) :- ok(Rest). ok([e,r,a,s,e,r | Rest]) :- ok(Rest).
この ok という述語が, 空から始めて,
dream dreamer erase eraser の付け足して成立させられるかを全探索してくれる.
ABC086C - Traveling
これはあんまし面白くない. こういうガリガリ実装するだけとなると, Prolog という言語はなんだか Lisp を書いてるような気持ちになる.
main :- get_number(N), solve(N, 0, 0, 0). solve(0, _, _, _) :- writeln("Yes"). solve(N, T0, X0, Y0) :- get_number(T), get_number(X), get_number(Y), DT is T - T0, Dist is abs(X - X0) + abs(Y - Y0), ok(DT, Dist) -> N1 is N - 1, solve(N1, T, X, Y); write("No"), nl. ok(DT, Dist) :- DT >= Dist, even(DT - Dist).
