AtCoder に登録したら解くべき精選過去問 10 問を Perl6 で解いてみた

はじめに

drken さんの記事で紹介されていた AtCoder に登録したら解くべき精選 10 問 をPerl6で解いてみました。
AtCoder Beginners Selection コンテストトップ
C++での解法を逐一Perl6に書き直しただけではあまり面白くないので、できるだけPerl6の言語機能を使って解きます。
AtCoderのPerl6は少し古いバージョン(rakudo-star 2016.01)なので、最新版とは動作が異なる場合があります。
また、クラスの細かい違いについては触れません。

問題の解答

第0問:PracticeA - はじめてのあっとこーだー

ここで入出力を確認します。

my ($a,$b,$c,$s);
$a=get;
($b,$c)=get.words;
$s=get;
say $a+$b+$c,' ',$s

複数の変数をまとめて宣言するには () で括ってリストのようにします。(!Perlでは必要なかった変数の宣言が、Perl6では必要です!)
get は(ファイルハンドルを指定していないので)標準入力から一行読み込み、末尾の改行を除いて、文字列を返します。
words は文字列を連続した空白でsplitして、リストを返します。(Perl6ではRubyのようなルーチンのチェインができます。)
5行目において、演算子 + で文字列を「数値として評価して」足し合わせています。このように、Perl6では型を自在に変更することができます。

ところで、空白区切りで出力するにあたって ' 'を埋め込むのはあまり美しくありませんね。実は、以下のように書けます。

put ($a+$b+$c,$s)

出力する値二つをリストにして put で出力すると、空白区切りになります。
では say では同じことができないのか?できません。なぜなら、出力する値を文字列にするときの形式が異なるからです。
say では人間が読みやすい形式に、 put では機械が読みやすい形式に変換します。(say でも文字列はそのまま出力される点で、 Rubyの Kernel#p とは異なります。)

さて、変数を宣言するのは面倒ですね。なるべく使わないようにして書き直してみましょう。
まず3つの数字を足し合わせるのですが、 sumというルーチンがあります。これを使えるようにしてみましょう。入力の二行目まで読んで、 words を適用すればよさそうです。

一度に複数の行を読むには、 linesを使います。何も指定しないとEOFまで読んでしまうので、引数で指定しましょう。このとき、一番目の引数であるファイルハンドルも指定する必要があることに注意です。C言語で言うところの stdin はPerl6において $*IN です。

put (lines($*IN,2).words.sum,get)

実は lines は改行で区切ってリストを返すのですが、なぜ文字列のルーチン words が使えるのでしょうか?実は、同名のルーチン words が複数定義されており、リスト(の親クラス)でも定義されているのです。

第1問:ABC086A - Product

「2つの数字のうち1つ以上が $2$ で割り切れるとき $Even$ 、そうでないとき $Odd$ を出力」という方針で解きます。

my ($a,$b)=get.words;
say $a%2==0||$b%2==0 ?? "Even" !! "Odd"

変数は宣言と同時に代入することができます。
Perl6の三項演算子は ?? !! です。

さて、 Junction というものがあります。

Junction はBool値の重ね合わせを表現します。
例えば、「 $a2 と等しい、または $b2 と等しい、または $c2 と等しい」は $a|$b|$c == 2 と書くことができます。
& , | , ^ があり、それぞれ「全ての」「一つ以上の」「一つだけの」を表します。
リストから作る場合は、それぞれ all , any , one と対応します。

また、演算子 %% を使うと $a % $b == 0$a %% $b と書けます。

これらを使うと、 $a%2==0||$b%2==0$a|$b%%2 となります。
さらに、変数を経由せず Junction を直接リストから作ることで、最終的に以下のコードができます。

say get.words.any%%2 ?? "Even" !! "Odd"

第2問:ABC081A - Placing Marbles

文字ごとに分解して、 $1$ と等しいものだけのリストを作り、その長さを求めます。
文字ごとに分解するのは comb 、リストから条件に合う要素を抜き出すのは grep 、リストの長さを求めるのは elems というルーチンがあります。

say get.comb.grep({$_==1}).elems

grep に条件式をブロックにして渡します。ブロックに渡される値が暗黙的に $_ に代入されるのはPerlと同じです。(明示的に渡すことも、複数個渡すこともできます。)

さて、Perlにおいてリストは、数値として評価されたとき自分の長さを返しました。実はPerl6でもこの仕様は変わっていません。
数値として評価する際、最も簡単なのは接頭辞 + をつけることです。以下のように書けます。

say +get.comb.grep({$_==1})

第3問:ABC081B - Shift only

$A_i$ を二進数で表記したとき、末尾に連続して現れる 0 の個数の最小値を調べましょう。
Perl6には、まさにこのためのルーチン lsb が用意されています。(Java の numberOfTrailingZeros() よりはるかに短い名前ですね!
ただ、注意点として、ルーチン呼び出しに型を変更する機能はないので、読み込んだ文字列を事前に Int にしておく必要があります。これには、ルーチン Int が使えます。(上で紹介したように、接頭辞 + でもできます)

get;
say get.words.map({$_.Int}).map({$_.lsb}).min

map は、リストのすべての要素にブロックを実行し、結果をリストにまとめて返すルーチンです。

ところで、ルーチン一つ適用するために map を持ち出すのはちょっとばかり大げさではないでしょうか。 hyper演算子 << >> を使えば、非常に簡潔に書くことができます。例えば今回の場合だと、以下のようになります。

get.words>>.Int>>.lsb.min

Perl6の構文解析器は、上のコードを ( ( (get.words) >> .Int ) >>. lsb ) .min と解釈するので、 (get.words>>.Int.lsb).min とは書けません。

接頭辞 + を適用したい場合は、以下のようになります。正しい順番で評価されるように、括弧を使う必要があります。

get;
say (+<<get.words)>>.lsb.min

hyper演算子の注意点として、リストのすべての要素に適用されることは保証されますが、適用される順番については保証されません。入出力を伴うなど、評価の順番に意味がある場合は、使用できません。

第4問:ABC087B - Coins

$0..A , 0..B , 0..C$ から要素を1つづつ取り出して作れる組み合わせを何とかして列挙できないでしょうか。
できます。演算子 X を使います。
(0..$a X 0..$b X 0..$c) で「全ての「3つの要素からなるリスト」の組み合わせのリスト」を得られますから、それに grep を適用しましょう。

my ($a,$b,$c,$x)=lines;
say +(0..$a X 0..$b X 0..$c).grep({$x==$_[0]*500+$_[1]*100+$_[2]*50})

TLEしました。

経験的に、Perl6で $10^5$ 回のループを回すとTLEします。 $50^3 > 10^5$ なので当然今回もTLEです。仕方ないので、 $a , $b を全探索します。

my ($a,$b,$c,$x)=lines;
say +(0..$a X 0..$b).map({$x-$_[0]*500-$_[1]*100}).grep({$_%%50&&$c>=$_/50>=0})

無事ACできました。

一気に grep しても良いのですが、一旦 map で $X$ との差額を保存しています。この方が少しコードがすっきりします。
$c>=$_/50>=0 とあるように、Perl6ではPythonと同様、比較演算子をチェインすることができます。

第5問:ABC083B - Some Sums

数値から各桁の和を求めるには、 comb で文字ごとに区切り、 sum で和を求めればよさそうです。

my ($n,$a,$b)=get.words;
say +(1..$n).grep({$b>=$_.comb.sum>=$a}).sum

TLEしました。

横着せず、ちゃんと10で割っていって各桁の和を求めてみます。

my ($n,$a,$b)=get.words;
say (1..$n).grep({
    my ($sum,$now)=0,$_;
    $sum+=$now%10,$now div=10 while $now>0;
    $b>=$sum>=$a
}).sum

div は切り捨て除算の演算子です。

TLEしました。

各桁の数字を一つづつ決めていく方法も実装しましたが、TLEしました。 ACできたようです! climpetさん、ありがとうございます。

ACコードでは for 文と min , max 演算子を使っているので、少し説明します。

for リスト -> 変数名 {
    処理のブロック
}

上のような文法です。また、 for 文全体を () でくくることによって、それぞれのブロックの返り値(最後に評価された値になります)を集めてリストにする、 map のような役割もできます。

ルーチンでもありますが、演算子としても min , max があります。つまり、以下のようなコードが書けます。

$ans max=$now

第6問:ABC088B - Card Game for Two

$a$ を降順にソートして、偶数番目の要素の総和から奇数番目の要素の総和を引きます。

get;
my$a=get.words.sort({-$_});
say $a[0,2...*].sum-$a[1,3...*].sum

ルーチン sort には mapgrep と同じようにブロックを渡せて、そのブロックの引数が1個か2個かによって動作が異なります。

1個のとき -> リストの各要素を渡したブロックの評価結果を比較してソートします。
2個のとき -> ブロックを比較関数としてソートします。
どちらも、元のリストの要素を変更しない点は同じです。

また、 get.words の時点ではリストの要素はすべて文字列のため、そのまま sort すると文字列の比較となってしまいますから、 Int 型に変換する必要があります。

以上のことより、 sort にブロック {-$_} を渡すのが最もシンプルなやり方です。

$a[インデックスのリスト] はリストのスライスをします。
このインデックスのリストには、Haskellでおなじみの数列展開を用いています。最初の2つの要素を与えると、等差数列とみなして終点まで要素を作り出してくれるものです。

上のコードでは、終点として * と書きました。リストのインデックス中で * と書くと、そのリストのサイズに置き換わってくれます。
この機能を用いると、リストの最後の要素は $a[*-1] のように書けます。(他の多くの言語では a[-1] で済むのですが…)

ところで、Perlを書いた人なら、 $a にリストを代入しているのが不自然に感じられませんか?Perl6ではシジル $ の変数にリストなどを格納することができるようになりました。(@% も使えますが)

別解

さて、実はこの問題には面白い解法があります。言葉で言い表すのは難しいので、疑似コードみたいなものを書きました。

sort(a)
ans=0
for(i in 0..a.size-1)ans=a[i]-ans

これが正しいことの証明は置いておいて、Perl6で実装します。

ans にリストを順番に適用していく、いわば畳み込みですね。ぐっとにらむとリストの先頭に特別に 0 を追加したりする必要はないとわかります。
Haskellなら foldl1 、Rubyなら Enumerable#reduce を使うところですが、Perl6ではどうしたらいいでしょう。

Perl6にも reduce があります。

get;
say get.words>>.Int.sort.reduce({$^b-$^a})

reduce にもブロックを渡す必要がありますが、そのブロックは2つの引数をとる必要があります。つまり、これまでの $_ が使えないということです。
ですがご心配なく、2つの場合は $^a$^b が宣言なしに使えます。

変数名の先頭にくっついている記号が $ から $^ に変わりましたね?これはPerlのシジルを発展させた Twigil (トゥイジル)で、この場合その変数がブロックの引数であることを表しています。

上のコードでは $^a の前に $^b が評価されますが、変数名のユニコードでの順番とブロックの引数の順番が対応付けられているので、問題なく $^a が一番目の引数を表します。

第7問:ABC085B - Kagami Mochi

2行目以降を lines で読んで、重複を取り除いた後のリストの長さを出力すれば良いですね。
unique があります。使いましょう。

get;
say +lines.unique

さて、Rubyには Array#uniq というメソッドがあります。こちらは6文字、あちらは4文字です。ちょっと不愉快ですね。

Pythonではこういう時、 set を使うんでしたか、Perl6でも似たようなことができないでしょうか。
できます。

Set クラスがあるので、リスト型からこれを作りましょう。と言っても、ただルーチン Set を呼び出すだけです。Set の要素数も、リストと同じように取得できます。

get;
say +lines.Set

unique -> Set となり、Rubyの uniq よりも短くなりました!やはりこうでなくっちゃ

第8問:ABC085C - Otoshidama

$N≦2000$ なので、 $O(N^2)$ はTLEします。そう、Perl6ならね。

よく考えると、 $45000=5000*9=10000*4+1000*5$ なので5千円札の枚数の探索は 0..8 でよいです。
また、3つの数のうち1つが決まると、ほかの2つは一意に定まるので、結局 $O(1)$ で解けます。これならPerl6でも安心です。

my ($n,$y)=get.words;
put (0..8).map({
    my$Y=($y-$_*4000-$n*1000)/9000;
    ($Y,$_,$n-$Y-$_)if $Y%1==0&&($n-$Y-$_&$Y)>=0
})||(-1,-1,-1)

$Y は1万円札の枚数なのですが、まず3行目において 9000 で割り切れたかどうかを調べます。
Perl6やAWKでは、実数にも剰余演算子が使えるので、 1 で割ったあまり(=小数点以下)が 0 と等しいかで割り切れたかどうかを調べます。
また、千円札や1万円札の枚数は非負である必要があるので、 Junction を用いて調べておきます。

以上の条件を満たすと、後置 if の式が評価されて、 map に答えのリストが返ります。
5千円札の枚数の探索範囲を 0..8 にしたことで、解が存在するなら一意に定まるようになりました。

一回も後置 if の式が評価されなかった場合(解が見つからなかった場合)、 map は空リスト(= False)になるため、 || の右側が評価され、式全体として (-1,-1,-1) になります。

第9問:ABC049C - 白昼夢 / Daydream

文字列を逆順にして、貪欲に当てはめていく解法を使います。

say get.comb.reverse.join~~/^(resare|esare|remaerd|maerd)*$/??"YES"!!"NO"

reverse はリストを反転します。
join は引数に与えられた文字列(なければ空文字列)を挟みつつリストを結合します。
正規表現については特に解説しません。
文字列長が $10^5$ なのでちょっとTLEが怖かったですが、別にループを回したわけでもないので通りました。

(追記)思い直すと、正規表現を使うのは貪欲とは言えませんね。というかそもそも正規表現は頭が良いので、使えるなら文字列を反転させる必要もないです。

say get~~/^(dream|dreamer|erase|eraser)*$/??"YES"!!"NO"

第10問:ABC086C - Traveling

$N≦10^5$ という文字列が目に入った瞬間、とても嫌な予感がしました。
とりあえず実装しました。

get;
my ($t,$x,$y);
say lines>>.words.map({
    my$T=$_[0]-$t;
    my$d=($_[1]-$x).abs+($_[2]-$y).abs;
    ($t,$x,$y)=@($_);
    $T>=$d&&$T%2==$d%2
}).all??"Yes"!!"No"

TLEしました。

変数を初期化せずに使用していますが、ただ警告が出るだけで実際は空文字列(= 0)として評価されます。
abs は絶対値を求めるルーチンです。

6行目において、複数の変数にまとめて代入しようとしています。
@($_) という書き方をしているのは、右辺の値を明示的にリストにしなければいけないからです。Perlであればリストを表す変数の先頭には @ がつくのですが、Perl6では必ずしもそうとは言えず、特に今回のようにリストのリストで map を使ったりすると $_ にリストが代入されることになります。

map に渡したブロックの最後に条件式を書いておくことで、真偽値のリストができました。 Junction はこのような形でも作ることができます。

さて、コードの解説は終了しました。結構シンプルに書いたつもりなので、これでTLEしてしまうようであれば、この問題もPerl6でACできないのだろうと思います。(もしACできた方がいらっしゃいましたら教えてください。)

おわりに

最後の1問が時間制限に引っかかりACできませんでした。
Perl6は、魅力的で高機能な言語仕様と引き換えに、とてつもない量のリソースを食います。そのため、複雑な競技プログラミングの問題を解くのには向いていませんが、シンプルな問題を解こうとしたときには絶大な威力を発揮します。

紹介したい言語機能があと2つあるので、AtCoderから問題を見つけてきました。

おまけ1:B - Lucas Number

第6問で、数列展開を紹介しました。等差数列の場合は初めの2項から差を計算して作り出してくれましたが、今回は漸化式が少し複雑なので厳しそうですね…

できます。

say (2,1,{$^a+$^b}...*)[get]

漸化式をブロックの形にして埋め込むと、数列に展開してくれます。終点は * ですが、インデックス中ではないので、これは遅延評価で無限に生成することを表します。
上のコードは、作り出したリストを変数に保存したりしていないのでとてもシンプルですね。

おまけ2:C - Multiple Clocks

2行目以降の値すべての lcm を求める問題です。

ところで、Perl6には簡約演算子というものがあり、中置2項演算子を [] で囲んでリストの前に置くと、リスト全体を fold したのと同じ結果が得られます。例えば、

say [*] 1..10

は $10! = 3628800$ を出力します。また、ルーチン sum は前置 [+] と同じ意味です。

さらに、Perl6には演算子 gcd , lcm があります。これは読んで字のごとく、最大公約数と最小公倍数を求める「中置2項演算子」です。
演算子なので、ルーチン呼び出しとは違い引数の型を変更できます。

Perl6によるこの問題の解答は以下のようになります。

get;
say [lcm] lines
Sign up for free and join this conversation.
Sign Up
If you already have a Qiita account log in.