はじめに
2020年に行われた言語アップデートの前に書いた記事なので、いくつか現在のRaku(Perl6はRakuに改名されました)には当てはまらない記述があります。
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
とは異なります。)
(追記)文字列に変数や式を埋め込む方法があって、おそらくそちらを最初に紹介するべきでした……。上のコードは次のようにも書けます。
say "{$a+$b+$c} $s"
さて、**変数を宣言するのは面倒ですね。**なるべく使わないようにして書き直してみましょう。
まず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値の重ね合わせを表現します。
例えば、「 $a
が 2
と等しい、または $b
が 2
と等しい、または $c
が 2
と等しい」は $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})
経験的に、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
横着せず、ちゃんと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しました。 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
には map
や grep
と同じようにブロックを渡せて、そのブロックの引数が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=50009=100004+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"
変数を初期化せずに使用していますが、ただ警告が出るだけで実際は空文字列(= 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