ズンドコキヨシ with パターンマッチ指向言語Egison

パターンマッチといえばこの言語でしょう

「ズン・ズン・ズン・ズン・ドコ」のパターンにマッチしたら「キ・ヨ・シ！」と出力するものを実装する流行りがあるらしい（ズンドコキヨシ）。

パターンマッチといえばEgison。

これはやらない手はない。

以下、私の回答。環境はMac。ココからインストールし、あとは端末から下記を実行。

Terminal

# Egisonの対話スクリーンに入る
$ egison

# 実行
> ((match-lambda (list string) {[ <join $a (loop $i [1 4] <cons (& ,"ズン" $z_i) ...> (& <cons ,"ドコ" _> $d))> [a z (car d) "キ・ヨ・シ ！"]]}) (map 1#(R.car {"ズン" "ドコ"}) nats))

結果

[{"ズン" "ズン" "ドコ" "ドコ" "ズン" "ズン" "ドコ" "ズン" "ズン" "ズン" "ドコ" "ドコ" "ドコ"} {|[1 "ズン"] [2 "ズン"] [3 "ズン"] [4 "ズン"]|} "ドコ" "キ・ヨ・シ ！"]

などということをGistでやっていたらまさかのEgison作者様からコメントが。

以下、引用。
下記のようなkiyoshi.egiというファイルを作成。

kiyoshi.egi

(define $main
  (lambda [$args]
      (each print (kiyoshi (match-all (map 1#(R.car {"ズン" "ドコ"}) nats) (list string)
                              [<join _ (loop $i [1 5] <cons $z_i ...> _)> {z_1 z_2 z_3 z_4 z_5}])))))

(define $kiyoshi
  (match-lambda (list (list string))
            {[<cons (& (loop $i [1 4] <cons ,"ズン" ...> <cons ,"ドコ" <nil>>) $zs) _> {@zs "キ・ヨ・シ ！"}]
              [<cons <cons $x _> $xs> {x @(kiyoshi xs)}]}))

あとは実行。

Terminal

$ egison kiyoshi.egi
ドコ
ドコ
ドコ
ドコ
ドコ
ドコ
ドコ
ズン
ズン
ズン
ズン
ドコ
キ・ヨ・シ ！

解説

Main関数

役割は2つ。

1. (map 1#(R.car {"ズン" "ドコ"})で延々とズン or ドコを出力。
2. その出力をマッチ節[<join _ (loop $i [1 5] <cons $z_i ...> _)> {z_1 z_2 z_3 z_4 z_5}]で5要素ずつずらす。

(define $main
  (lambda [$args]
      (each print (kiyoshi (match-all (map 1#(R.car {"ズン" "ドコ"}) nats) (list string)
                              [<join _ (loop $i [1 5] <cons $z_i ...> _)> {z_1 z_2 z_3 z_4 z_5}])))))

たとえば10個の整数をこれと同じマッチ節で処理すると、こんな出力になる。

EgisonTerminal

> (match-all (take 10 nats) (list integer) [<join _ (loop $i [1 5] <cons $z_i ...> _)> {z_1 z_2 z_3 z_4 z_5}])
{{1 2 3 4 5} {2 3 4 5 6} {3 4 5 6 7} {4 5 6 7 8} {5 6 7 8 9} {6 7 8 9 10}}

kiyoshi関数

再帰処理をしている。
Mainが出力したズンとドコをランダムに含んだコレクションのコレクション（配列の配列ようなもの）を受け取る。先頭のコレクションを取り出し、パターンにマッチしていたら"キ・ヨ・シ！"を付与して処理終了。
マッチしていなかった場合、その要素を取り除き、再度自分を呼び出して残りのコレクションを処理させる。

(define $kiyoshi
  (match-lambda (list (list string))
            {[<cons (& (loop $i [1 4] <cons ,"ズン" ...> <cons ,"ドコ" <nil>>) $zs) _> {@zs "キ・ヨ・シ ！"}]
              [<cons <cons $x _> $xs> {x @(kiyoshi xs)}]}))