平面や空間などの座標において、各成分がすべて整数であるような点を「格子点 (lattice point)」といいます。たとえば、二次元の座標 (x, y) で x と y の範囲が有限であれば、格子点は直積集合で求めることができます。x と y が無限の場合、直積集合と同様に対角線上に格子点を生成していくことになります。
二次元において、0 から無限大の格子点を生成するプログラムは unfold だけで定義することができます。次のリストを見てください。
リスト : 二次元の格子点 (def lattice2 (unfold (fn [[a b]] (if (zero? a) (list b (inc a)) (list (dec a) (inc b)))) '(0 0)))
unfold の初期値は (0 0) です。対角線上に格子点 (x y) を出力すると、(0 0), (1 0), (0 1), (2 0), (1 1), (0 2), ... となります。n 番目の対角線の場合は (n 0), (n-1 1), ... (1 n-1), (0 n) になるので、(x-1 y+1) で次の項を生成することができます。(0 n) を出力したら次の対角線 (n + 1) に移ります。これは (x y) を (y+1 0) にするだけです。
それでは実際に試してみましょう。
user=> (take 55 lattice2) ((0 0) (0 1) (1 1) (0 2) (2 1) (1 2) (0 3) (3 1) (2 2) (1 3) (0 4) (4 1) (3 2) (2 3) (1 4) (0 5) (5 1) (4 2) (3 3) (2 4) (1 5) (0 6) (6 1) (5 2) (4 3) (3 4) (2 5) (1 6) (0 7) (7 1) (6 2) (5 3) (4 4) (3 5) (2 6) (1 7) (0 8) (8 1) (7 2) (6 3) (5 4) (4 5) (3 6) (2 7) (1 8) (0 9) (9 1) (8 2) (7 3) (6 4) (5 5) (4 6) (3 7) (2 8) (1 9))
次は lattice2 を一般化して、d 次元の格子点を生成する関数 lattice d を考えてみましょう。二次元の場合、同じ対角線上にある格子点 (x, y) は x + y の値が同じになりますね。d 次元の場合、座標 (x, y, z, ...) の合計値を基準に考えればよさそうです。たとえば、三次元の場合は次のようになります。
n | 0 | 1 | 2
---+-----------+-----------+------------
| (0, 0, 0) | (0, 0, 1) | (0, 0, 2)
| (0, 1, 0) | (0, 1, 1)
| (1, 0, 0) | (0, 2, 0)
| (1, 0, 1)
| (1, 1, 1)
| (1, 1, 0)
| (2, 0, 0)
これは笹川さんの twitter と MARUYAMA Satosi さんのページ「関数型言語 Haskell」を参考にさせていただきました。お二人は参考文献に向井淳氏の「入門Haskell―はじめて学ぶ関数型言語」をあげておられます。有益な情報を Web 上で公開されている笹川さんと MARUYAMA Satosi さんに感謝いたします。
プログラムは次のようになります。
リスト : d 次元格子点の生成
(defn lattice-sub [d n]
(cond
(== d 1) (lazy-seq (cons (list n) '()))
(zero? n) (lazy-seq (cons (repeat d 0) '()))
:else (mapcat (fn [x] (map (fn [xs] (cons x xs))
(lattice-sub (dec d) (- n x))))
(range 0 (inc n)))))
(defn lattice [d]
(mapcat (fn [n] (lattice-sub d n)) (unfold inc 0)))
実際の処理は関数 lattice-sub d n で行います。d が次元を、n が要素の合計値を表します。d が 1 のとき、合計値は n しかありません。(n) を格納した遅延シーケンスを返します。n が 0 のときは、d 個の 0 を格納したリストを生成し、それを遅延シーケンスに格納して返します。そうでなければ、先頭の要素 x を 0 から n まで順番に選び、d - 1 次元の格子点を lattice_sub で生成します。あとは lattice で 0 から始まる無限整数列を生成し、lattice-sub を呼び出すだけです。
それでは実行してみましょう。
user=> (def s1 (lattice 1)) #'user/s1 user=> (take 60 s1) ((0) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32) (33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59)) user=> (def s2 (lattice 2)) #'user/s2 user=> (take 60 s2) ((0 0) (0 1) (1 0) (0 2) (1 1) (2 0) (0 3) (1 2) (2 1) (3 0) (0 4) (1 3) (2 2) (3 1) (4 0) (0 5) (1 4) (2 3) (3 2) (4 1) (5 0) (0 6) (1 5) (2 4) (3 3) (4 2) (5 1) (6 0) (0 7) (1 6) (2 5) (3 4) (4 3) (5 2) (6 1) (7 0) (0 8) (1 7) (2 6) (3 5) (4 4) (5 3) (6 2) (7 1) (8 0) (0 9) (1 8) (2 7) (3 6) (4 5) (5 4) (6 3) (7 2) (8 1) (9 0) (0 10) (1 9) (2 8) (3 7) (4 6)) user=> (def s3 (lattice 3)) #'user/s3 user=> (take 60 s3) ((0 0 0) (0 0 1) (0 1 0) (1 0 0) (0 0 2) (0 1 1) (0 2 0) (1 0 1) (1 1 0) (2 0 0) (0 0 3) (0 1 2) (0 2 1) (0 3 0) (1 0 2) (1 1 1) (1 2 0) (2 0 1) (2 1 0) (3 0 0) (0 0 4) (0 1 3) (0 2 2) (0 3 1) (0 4 0) (1 0 3) (1 1 2) (1 2 1) (1 3 0) (2 0 2) (2 1 1) (2 2 0) (3 0 1) (3 1 0) (4 0 0) (0 0 5) (0 1 4) (0 2 3) (0 3 2) (0 4 1) (0 5 0) (1 0 4) (1 1 3) (1 2 2) (1 3 1) (1 4 0) (2 0 3) (2 1 2) (2 2 1) (2 3 0) (3 0 2) (3 1 1) (3 2 0) (4 0 1) (4 1 0) (5 0 0) (0 0 6) (0 1 5) (0 2 4) (0 3 3)) user=> (def s4 (lattice 4)) #'user/s4 user=> (take 60 s4) ((0 0 0 0) (0 0 0 1) (0 0 1 0) (0 1 0 0) (1 0 0 0) (0 0 0 2) (0 0 1 1) (0 0 2 0) (0 1 0 1) (0 1 1 0) (0 2 0 0) (1 0 0 1) (1 0 1 0) (1 1 0 0) (2 0 0 0) (0 0 0 3) (0 0 1 2) (0 0 2 1) (0 0 3 0) (0 1 0 2) (0 1 1 1) (0 1 2 0) (0 2 0 1) (0 2 1 0) (0 3 0 0) (1 0 0 2) (1 0 1 1) (1 0 2 0) (1 1 0 1) (1 1 1 0) (1 2 0 0) (2 0 0 1) (2 0 1 0) (2 1 0 0) (3 0 0 0) (0 0 0 4) (0 0 1 3) (0 0 2 2) (0 0 3 1) (0 0 4 0) (0 1 0 3) (0 1 1 2) (0 1 2 1) (0 1 3 0) (0 2 0 2) (0 2 1 1) (0 2 2 0) (0 3 0 1) (0 3 1 0) (0 4 0 0) (1 0 0 3) (1 0 1 2) (1 0 2 1) (1 0 3 0) (1 1 0 2) (1 1 1 1) (1 1 2 0) (1 2 0 1) (1 2 1 0) (1 3 0 0))
正常に動作していますね。
次は、要素を昇順に出力する 2 つの遅延シーケンスを併合 (マージ, merge) する関数を作りましょう。次のリストを見てください。
リスト : 遅延シーケンスのマージ
(defn merge-seq [s1 s2]
(cond
(not (seq s1)) s2
(not (seq s2)) s1
(<= (first s1) (first s2))
(lazy-seq (cons (first s1) (merge-seq (rest s1) s2)))
:else
(lazy-seq (cons (first s2) (merge-seq s1 (rest s2))))))
merge-seq は 2 つの遅延シーケンスを併合して新しい遅延シーケンスを返します。s1 が空であれば s2 を返し、s2 が空ならば s1 を返します。そうでなければ、遅延シーケンスの先頭要素を比較します。s1 の要素が s2 の要素以下ならば s1 の要素を、そうでなければ s2 の要素を遅延シーケンスに格納します。
簡単な実行例を示しましょう。
user=> (def s1 (unfold #(+ % 2) 1)) #'user/s1 user=> (def s2 (unfold #(+ % 2) 2)) #'user/s2 user=> (def s3 (merge-seq s1 s2)) #'user/s3 user=> (take 10 s1) (1 3 5 7 9 11 13 15 17 19) user=> (take 10 s2) (2 4 6 8 10 12 14 16 18 20) user=> (take 20 s3) (1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20) user=> (take 20 (merge-seq s1 s1)) (1 1 3 3 5 5 7 7 9 9 11 11 13 13 15 15 17 17 19 19)
ここで、遅延シーケンスには重複要素が存在せず、要素は昇順に出力されることを前提にすると、遅延シーケンスでも集合演算を行うことができます。次のリストを見てください。
リスト : 集合演算
;; 和集合
(defn union-seq [s1 s2]
(cond
(not (seq s1)) s2
(not (seq s2)) s1
(== (first s1) (first s2))
(lazy-seq (cons (first s1) (union-seq (rest s1) (rest s2))))
(< (first s1) (first s2))
(lazy-seq (cons (first s1) (union-seq (rest s1) s2)))
:else
(lazy-seq (cons (first s2) (union-seq s1 (rest s2))))))
;; 積集合
(defn intersect-seq [s1 s2]
(cond
(or (not (seq s1)) (not (seq s2))) '()
(== (first s1) (first s2))
(lazy-seq (cons (first s1) (intersect-seq (rest s1) (rest s2))))
(< (first s1) (first s2))
(recur (rest s1) s2)
:else
(recur s1 (rest s2))))
union-seq は s1 と s2 から要素を取り出して、小さいほうを遅延シーケンスに追加します。等しい場合は要素をひとつだけ追加します。このとき、s1 と s2 の両方から先頭要素を取り除くことに注意してください。
intersect-seq も簡単です。s1, s2 の先頭要素を比較して、等しい場合はその要素を遅延シーケンスに追加します。s1 の要素が s2 の要素よりも小さい場合は、s1 を一つ進めて次の要素を調べます。s2 の要素が小さい場合は s2 の次の要素を調べます。
簡単な実行例を示しましょう。
user=> (def s1 (scan-left + 1 (unfold inc 2))) #'user/s1 user=> (def s2 (map #(* % %) (unfold inc 1))) #'user/s2 user=> (take 20 s1) (1 3 6 10 15 21 28 36 45 55 66 78 91 105 120 136 153 171 190 210) user=> (take 20 s2) (1 4 9 16 25 36 49 64 81 100 121 144 169 196 225 256 289 324 361 400) user=> (take 20 (union-seq s1 s2)) (1 3 4 6 9 10 15 16 21 25 28 36 45 49 55 64 66 78 81 91) user=> (take 7 (intersect-seq s1 s2)) (1 36 1225 41616 1413721 48024900 1631432881)
遅延シーケンス s1 は「三角数」、s2 は「四角数」を表します。これらの遅延シーケンスを union-seq でまとめると、三角数または四角数の数列になります。intersect-seq でまとめると、三角数かつ四角数の数列 (平方三角数) になります。平方三角数は拙作のページ Puzzle DE Progamming: 「多角数」でも取り上げています。興味のある方はお読みくださいませ。
ここで union-seq を使うと簡単に解ける問題を紹介しましょう。
7 以上の素数で割り切れない正の整数は、素因子が 2, 3, 5 しかない自然数のことで、これを「ハミング数 (Hamming Numbers)」といいます。ハミング数は素因数分解したとき、2i * 3j * 5k (i, j, k >= 0) の形式になります。たとえば、100 以下のハミング数は次のようになります。
1, 2, 3, 4, 5, 6, 8, 9, 10, 12, 15, 16, 18, 20, 24, 25, 27, 30, 32, 36, 40, 45, 48, 50, 54, 60, 64, 72, 75, 80, 81, 90, 96, 100
遅延シーケンスを使うと「ハミングの問題」は簡単に解くことができます。小さい順にハミング数を出力する遅延シーケンスを hs としましょう。hs は 1 から始まるので次のように定義できます。
(def hs (lazy-seq (cons 1 (...))))
最初の要素は 1 なので、それに 2, 3, 5 を掛け算した値 (2, 3, 5) もハミング数になります。この値は次の S 式で生成することができます。
(map #(* % 2) hs) (map #(* % 3) hs) (map #(* % 5) hs)
あとは、これらの遅延シーケンスを union-seq でひとつにまとめて、小さい順に出力すればいいわけです。
これを Clojure でプログラムしてみましょう。
リスト : ハミングの問題
(def hs (lazy-seq (cons 1 (union-seq (map #(* % 2) hs)
(union-seq (map #(* % 3) hs)
(map #(* % 5) hs))))))
実はこのプログラム、動作しません。
user=> (take 50 hs) Error printing return value (StackOverflowError) at ... null
他のプログラミング言語 (Common Lisp, Scheme, SML/NJ, OCaml などなど) では動作するのですが、Clojure ではエラーになってしまいます。原因がわからなかったので、ここであきらめることにしました。何かお気づきの点がありましたら、ご教示お願いいたします。
次は遅延シーケンスを使って順列を生成するプログラムを作ってみましょう。遅延シーケンスを使う場合、再帰呼び出しの一番深いところで順列が完成するようにプログラムするとうまくいきません。要素が n 個の順列を生成する場合、n - 1 個の順列を生成するシーケンスを生成し、そこに要素を一つ加えて n 個の順列を生成すると考えます。
基本的には、拙作のページ「順列と組み合わせ」で作成した、順列をリストに格納して返すプログラムと同じです。このプログラムを遅延シーケンスに対応させると次のようになります。
リスト : 遅延シーケンスによる順列の生成
(defn make-perm [n s]
(if (zero? n)
(lazy-seq (cons '() '()))
(mapcat
(fn [x]
(map (fn [y] (cons x y))
(make-perm (dec n) (filter (fn [z] (not= x z)) s))))
s)))
関数 make-perm はシーケンス s の中から要素を n 個選ぶ順列を生成します。n = 0 の場合は空リストを格納したシーケンスを返します。あとは、mapcat の無名関数の中で、make-perm を再帰呼び出しして n - 1 個を選ぶ順列を生成します。シーケンス s から要素 x を取り除くため、filter を使っています。これで順列を生成するシーケンスを作ることができます。
それでは実際に試してみましょう。
user=> (make-perm 4 (range 1 5)) ((1 2 3 4) (1 2 4 3) (1 3 2 4) (1 3 4 2) (1 4 2 3) (1 4 3 2) (2 1 3 4) (2 1 4 3) (2 3 1 4) (2 3 4 1) (2 4 1 3) (2 4 3 1) (3 1 2 4) (3 1 4 2) (3 2 1 4) (3 2 4 1) (3 4 1 2) (3 4 2 1) (4 1 2 3) (4 1 3 2) (4 2 1 3) (4 2 3 1) (4 3 1 2) (4 3 2 1))
24 通りの順列をすべて求めることができました。
同様に、遅延シーケンスを使って 8 クイーンを解くことができます。
リスト : 8 クイーンの解法 (遅延シーケンス版)
;; 衝突のチェック
(defn attack
([q xs] (attack q xs 1))
([q xs n]
(cond
(not (seq xs)) false
(or (= (+ q n) (first xs)) (= (- q n) (first xs))) true
:else (attack q (rest xs) (inc n)))))
;; N Queen の解を求める
(defn queen [s]
(if (not (seq s))
(lazy-seq (cons '() '()))
(filter
(fn [ls] (or (not (seq ls))
(not (attack (first ls) (rest ls)))))
(mapcat
(fn [x]
(map (fn [y] (cons x y))
(queen (filter (fn [z] (not= x z)) s))))
s))))
関数 queen は make-perm とほぼ同じですが、追加したクイーンが他のクイーンと衝突している場合は filter を使って取り除いています。衝突をチェックする関数 attack は拙作のページ「生成検定法」の Eight Queens Problem で作成したプログラムと同じです。
それでは実行してみましょう。
user=> (take 10 (queen (range 1 9))) ((1 5 8 6 3 7 2 4) (1 6 8 3 7 4 2 5) (1 7 4 6 8 2 5 3) (1 7 5 8 2 4 6 3) (2 4 6 8 3 1 7 5) (2 5 7 1 3 8 6 4) (2 5 7 4 1 8 6 3) (2 6 1 7 4 8 3 5) (2 6 8 3 1 4 7 5) (2 7 3 6 8 5 1 4))
解の総数は全部で 92 通りあります。
最後に簡単な例題として、シーケンスを使って素数を求めるプログラムを作ってみましょう。
考え方は簡単です。最初に 2 から始まる整数列を生成するシーケンスを用意します。2 は素数なので、素数シーケンスの要素になります。次に、この整数列から 2 で割り切れる整数を取り除き除きます。これは filter を使うと簡単です。2 で割り切れる整数が取り除かれたので、次の要素は 3 になります。今度は 3 で割り切れる整数を取り除けばいいのです。これも filter を使えば簡単です。
このとき、入力用のシーケンスは 2 で割り切れる整数が取り除かれています。したがって、このシーケンスに対して 3 で割り切れる整数を取り除くように filter を設定すればいいわけです。このように、素数を見つけたらそれで割り切れる整数を取り除いていくアルゴリズムを「エラトステネスの篩」といいます。
ようするに、2 から始まる整数シーケンスに対して、見つけた素数 2, 3, 5, 7, 11, ... を順番に fiter で設定して素数でない整数をふるい落としていくわけです。
プログラムは次のようになります。
リスト : 素数の生成
(defn sieve [s]
(lazy-seq (cons (first s)
(sieve (remove (fn [x] (zero? (mod x (first s))))
(rest s))))))
sieve には 2 から始まる整数列を生成するシーケンスを渡します。rest で次の要素を求めると、remove により整数列から 2 で割り切れる整数を取り除いたシーケンスが返されます。次の要素 3 を取り出すとき、このシーケンスに対して 3 で割り切れる整数を取り除くことになるので、2 と 3 で割り切れる整数が取り除かれることになります。次の要素は 5 になりますが、そのシーケンスからさらに 5 で割り切れる整数が remove で取り除かれることになります。
このように remove を重ねて設定していくことで、素数でない整数をふるい落としていくことができるわけです。それでは実行してみましょう。
user=> (def ps (sieve (unfold inc 2))) #'user/ps user=> (take 25 ps) (2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97) user=> (take 100 ps) (2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389 397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499 503 509 521 523 541)
unfold で 2 から始まる整数列を sieve に渡します。100 以下の素数は全部で 25 個あります。
関数 sieve は簡単にプログラムできますが、生成する素数の個数が多くなると、その実行速度はかなり遅くなります。実をいうと、sieve なみに簡単で sieve よりも高速な方法があります。
整数 n が素数か確かめる簡単な方法は、√n 以下の素数で割り切れるか試してみることです。割り切れる素数 m があれば、n は素数ではありません。そうでなければ、n は素数であることがわかります。
これをそのままプログラムすると次のようになります。
リスト : 素数列の生成
(def primes)
(defn primep
([n] (primep n (rest primes)))
([n ps]
(let [p (first ps)]
(cond
(> (* p p) n) true
(zero? (mod n p)) false
:else (recur n (rest ps))))))
(defn primes-from [n]
(if (primep n)
(lazy-seq (cons n (primes-from (+ n 2))))
(recur (+ n 2))))
(def primes (lazy-cat [2 3 5] (primes-from 7)))
変数 primes は無限の素数列を表します。lazy-cat は引数のシーケンスを遅延シーケンスに変換して連結します。
実際に素数を生成する処理は関数 primes-from で行います。primes-from は述語 primep を呼び出して n が素数かチェックします。そうであれば、(lazy-seq (cons n ...)) で n を遅延シーケンスに追加します。そうでなければ primes-from を再帰呼び出しするだけです。偶数は素数ではないので、引数 n には奇数を与えていることに注意してください。
primep も簡単です。primes から √n 以下の素数 p を順番に取り出します。√n 以下の素数は生成済みなので、primes から取り出すことが可能です。ここでは√n のかわりに条件を p * p <= n としています。√n 以下の素数で割り切れない場合、n は素数なので true を返します。p で割り切れる場合、n は素数ではないので false を返します。それ以外の場合、次の素数を調べます。
それでは実行してみましょう。
user=> (take 25 primes) (2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97) user=> (nth primes 99) 541 user=> (nth primes 500) 3581
100 以下の素数は全部で 25 個あります。また、100 番目の素数は 541 になります。Clojure のリストは 0 から数えるので、(nth primes 99) で 100 番目の素数になります。
実行時間ですが、nth で 3001 番目の素数を求めてみました。実行環境は Ubunts 22.04 (Windows Subsystem for Linux), Intel Core i5-6200U 2.30GHz, sbcl version 1.4.5 です。
user=> (time (nth (sieve (unfold inc 2)) 3001)) "Elapsed time: 2412.255755 msecs" 27479 user=> (time (nth primes 3001)) "Elapsed time: 37.2257 msecs" 27479
sieve よりも primes のほうが高速になりました。興味のある方はいろいろ試してみてください。
差が 2 である素数の組を「双子素数 (twin prime)」といいます。素数列 primes を使うと双子素数は簡単に求めることができます。
リスト : 双子素数
(def twin (filter (fn [xs] (== (- (second xs) (first xs)) 2))
(map #(list %1 %2) primes (rest primes))))
user=> (take 100 twin) ((3 5) (5 7) (11 13) (17 19) (29 31) (41 43) (59 61) (71 73) (101 103) (107 109) (137 139) (149 151) (179 181) (191 193) (197 199) (227 229) (239 241) (269 271) (281 283) (311 313) (347 349) (419 421) (431 433) (461 463) (521 523) (569 571) (599 601) (617 619) (641 643) (659 661) (809 811) (821 823) (827 829) (857 859) (881 883) (1019 1021) (1031 1033) (1049 1051) (1061 1063) (1091 1093) (1151 1153) (1229 1231) (1277 1279) (1289 1291) (1301 1303) (1319 1321) (1427 1429) (1451 1453) (1481 1483) (1487 1489) (1607 1609) (1619 1621) (1667 1669) (1697 1699) (1721 1723) (1787 1789) (1871 1873) (1877 1879) (1931 1933) (1949 1951) (1997 1999) (2027 2029) (2081 2083) (2087 2089) (2111 2113) (2129 2131) (2141 2143) (2237 2239) (2267 2269) (2309 2311) (2339 2341) (2381 2383) (2549 2551) (2591 2593) (2657 2659) (2687 2689) (2711 2713) (2729 2731) (2789 2791) (2801 2803) (2969 2971) (2999 3001) (3119 3121) (3167 3169) (3251 3253) (3257 3259) (3299 3301) (3329 3331) (3359 3361) (3371 3373) (3389 3391) (3461 3463) (3467 3469) (3527 3529) (3539 3541) (3557 3559) (3581 3583) (3671 3673) (3767 3769) (3821 3823))
ところで、双子素数 - Wikipedia によると、『双子素数は無数に存在するかという問題、いわゆる「双子素数の予想」や「双子素数の問題」は、いまだに数学上の未解決問題である。無数に存在するだろう、とは、多くの数論学者が予想している。』 とのことです。
;;;
;;; lazyseq.clj : 遅延シーケンス
;;;
;;; Copyright (C) 2025 Makoto Hiroi
;;;
;; 遅延ストリームの生成
(defmacro stream-cons [a b]
`(list ~a (delay ~b)))
;; 先頭要素を参照する
(defn stream-first [s] (first s))
;; 先頭要素を取り除く
(defn stream-rest [s] (force (second s)))
;; 遅延ストリームの生成
(defmacro stream-cons' [a b]
`(delay (list ~a ~b)))
;; 先頭要素を参照する
(defn stream-first' [s] (first (force s)))
;; 先頭要素を取り除く
(defn stream-rest' [s] (second (force s)))
;; 整数列
(defn range' [start end]
(if (>= start end)
'()
(lazy-seq (cons start (range' (inc start) end)))))
;; フィボナッチ数列
(defn fibonacci
([] (fibonacci 0N 1N))
([a b]
(lazy-seq (cons a (fibonacci b (+ a b))))))
;; 解きほぐし
(defn unfold
([iterate seed] (unfold iterate seed (fn [_] false)))
([iterate seed pred]
(if (pred seed)
'()
(lazy-seq (cons seed (unfold iterate (iterate seed) pred))))))
(defn nth' [s n]
(if (zero? n)
(first s)
(recur (rest s) (dec n))))
;; 操作関数
(defn take' [n s]
(if (or (not (seq s)) (zero? n))
'()
(lazy-seq (cons (first s) (take' (dec n) (rest s))))))
(defn drop' [n s]
(if (or (not (seq s)) (zero? n))
s
(recur (dec n) (rest s))))
(defn concat' [s1 s2]
(if-not (seq s1)
s2
(lazy-seq (cons (first s1)
(concat' (rest s1) s2)))))
(defn interleave' [s1 s2]
(if-not (seq s1)
s2
(lazy-seq (cons (first s1)
(interleave' s2 (rest s1))))))
;; マッピング
(defn map' [proc s]
(if-not (seq s)
'()
(lazy-seq (cons (proc (first s))
(map' proc (rest s))))))
;; フィルター
(defn filter' [pred s]
(cond
(not (seq s)) '()
(pred (first s)) (lazy-seq (cons (first s) (filter' pred (rest s))))
:else (filter' pred (rest s))))
;; 畳み込み
(defn fold-left [proc a s]
(if-not (seq s)
a
(recur proc (proc a (first s)) (rest s))))
(defn fold-right [proc a s]
(if-not (seq s)
a
(proc (first s) (fold-right proc a (rest s)))))
;; 累積値を格納した遅延ストリームを返す
(defn scan-left [proc a s]
(lazy-seq (cons a (if-not (seq s)
'()
(scan-left proc (proc (first s) a) (rest s))))))
;; 巡回
(defn for-each [proc s]
(when (seq s)
(proc (first s))
(recur proc (rest s))))
;; 平坦化
(defn flatmap' [proc s]
(if-not (seq s)
'()
(concat' (proc (first s))
(flatmap' proc (rest s)))))
;; 遅延ストリームの連結 (遅延評価版)
(defn concat-delay [s1 s2]
(if-not (seq s1)
(force s2)
(lazy-seq (cons (first s1)
(concat-delay (rest s1) s2)))))
;; マッピングの結果を平坦化する
(defn flatmap'' [proc s]
(if-not (seq s)
'()
(concat-delay (proc (first s))
(delay (flatmap'' proc (rest s))))))
;; 述語 pred が真を返す要素を取り出す
(defn take-while' [pred s]
(if-not (pred (first s))
'()
(lazy-seq (cons (first s)
(take-while' pred (rest s))))))
;; 述語 pred が真を返す要素を取り除く
(defn drop-while' [pred s]
(if-not (pred (first s))
s
(recur pred (rest s))))
;; 組を生成するシーケンス
(defn pair-seq
([s1 s2] (pair-seq s1 s2 1))
([s1 s2 n]
(concat-delay
(map #(list %1 %2) (take n s1) (reverse (take n s2)))
(delay (pair-seq s1 s2 (inc n))))))
;; 格子点
;; 二次元
(def lattice2
(unfold (fn [[a b]] (if (zero? a) (list b (inc a)) (list (dec a) (inc b)))) '(0 0)))
;; d 次元
(defn lattice-sub [d n]
(cond
(== d 1) (lazy-seq (cons (list n) '()))
(zero? n) (lazy-seq (cons (repeat d 0) '()))
:else (mapcat (fn [x] (map (fn [xs] (cons x xs))
(lattice-sub (dec d) (- n x))))
(range 0 (inc n)))))
(defn lattice [d]
(mapcat (fn [n] (lattice-sub d n)) (unfold inc 0)))
;; 併合
(defn merge-seq [s1 s2]
(cond
(not (seq s1)) s2
(not (seq s2)) s1
(<= (first s1) (first s2))
(lazy-seq (cons (first s1) (merge-seq (rest s1) s2)))
:else
(lazy-seq (cons (first s2) (merge-seq s1 (rest s2))))))
;; 和集合
(defn union-seq [s1 s2]
(cond
(not (seq s1)) s2
(not (seq s2)) s1
(== (first s1) (first s2))
(lazy-seq (cons (first s1) (union-seq (rest s1) (rest s2))))
(< (first s1) (first s2))
(lazy-seq (cons (first s1) (union-seq (rest s1) s2)))
:else
(lazy-seq (cons (first s2) (union-seq s1 (rest s2))))))
(defn intersect-seq [s1 s2]
(cond
(or (not (seq s1)) (not (seq s2))) '()
(== (first s1) (first s2))
(lazy-seq (cons (first s1) (intersect-seq (rest s1) (rest s2))))
(< (first s1) (first s2))
(recur (rest s1) s2)
:else
(recur s1 (rest s2))))
;; ハミングの問題 (動かない)
(def hs (lazy-seq (cons 1 (union-seq (map #(* % 2) hs)
(union-seq (map #(* % 3) hs)
(map #(* % 5) hs))))))
;; 順列の生成
(defn make-perm [n s]
(if (zero? n)
(lazy-seq (cons '() '()))
(mapcat
(fn [x]
(map (fn [y] (cons x y))
(make-perm (dec n) (filter (fn [z] (not= x z)) s))))
s)))
;; 8 クイーンの解法 (遅延シーケンス版)
;; 衝突のチェック
(defn attack
([q xs] (attack q xs 1))
([q xs n]
(cond
(not (seq xs)) false
(or (= (+ q n) (first xs)) (= (- q n) (first xs))) true
:else (attack q (rest xs) (inc n)))))
;; N Queen の解を求める
(defn queen [s]
(if (not (seq s))
(lazy-seq (cons '() '()))
(filter
(fn [ls] (or (not (seq ls))
(not (attack (first ls) (rest ls)))))
(mapcat
(fn [x]
(map (fn [y] (cons x y))
(queen (filter (fn [z] (not= x z)) s))))
s))))
;; エラトステネスの篩
(defn sieve [s]
(lazy-seq (cons (first s)
(sieve (remove (fn [x] (zero? (mod x (first s))))
(rest s))))))
;; 高速化
(def primes)
(defn primep
([n] (primep n (rest primes)))
([n ps]
(let [p (first ps)]
(cond
(> (* p p) n) true
(zero? (mod n p)) false
:else (recur n (rest ps))))))
(defn primes-from [n]
(if (primep n)
(lazy-seq (cons n (primes-from (+ n 2))))
(recur (+ n 2))))
(def primes (lazy-cat [2 3 5] (primes-from 7)))
;; 双子素数
(def twin (filter (fn [xs] (== (- (second xs) (first xs)) 2))
(map #(list %1 %2) primes (rest primes))))