Lisp ライクで mutable な連結リスト (Mulist) です。拙作のページ「連結リスト (immutable)」で作成した連結リスト (Imlist) は再帰定義を多用しているため、長いリストを扱うとスタックオーバーフローする危険性がありました。今回はデータ構造を mutable に変更し、一部関数を除いて再帰定義を繰り返しに変換しています。学習が目的のプログラムですが、興味のある方は試してみてください。
immutable な連結リスト Imlist との大きな違いは、コンスセル Cons を mutable にするところです。次のリストを見てください。
リスト : コンスセルの修正 # コンスセル mutable struct Cons <: List car cdr end # 書き換え setcar!(xs::Cons, x) = xs.car = x setcdr!(xs::Cons, x) = xs.cdr = x
連結リストは複数のコンスセルを接続して構成されています。コンスセルにはデータを格納する car とコンスセルをつなぐ cdr という場所 (変数) があります。関数 car(), cdr() と区別するため、car 部と cdr 部と書くことにします。ここを直接書き換える関数 setcar!() と setcdr!() を定義します。
setcar!(cell, x) setcdr!(cell, x)
これらの関数は Lisp の rplaca, rplacd や scheme の set-car!, set-cdr! と同じ働きをします。setcar!(cell, x) はコンスセル cell の car 部を x に書き換えます。簡単な例を示しましょう。
julia> z = list(1, 2, 3) (1 2 3) julia> z (1 2 3) julia> setcar!(z, 4) 4 julia> z (4 2 3)
変数 z にリスト (1 2 3) をセットします。setcar!() はコンスセルの car 部、この場合は (1 2 3) の先頭セルの car 部を 1 から 4 に書き換えます。リストの car 部を直接書き換えるので、変数 z の値も (4 2 3) になることに注意してください。次の図を見てください。
car 部を直接 4 に書き換える │ ↓ ┌─┬─┐ ┌─┬─┐ ┌─┬─┐ 変数z─→│・│・┼─→│・│・┼─→│・│/│ └┼┴─┘ └┼┴─┘ └┼┴─┘ ↓ ↓ ↓ 1 2 3 ┌─┬─┐ ┌─┬─┐ ┌─┬─┐ 変数z─→│・│・┼─→│・│・┼─→│・│/│ └┼┴─┘ └┼┴─┘ └┼┴─┘ ↓ ↓ ↓ 4 2 3 図 : setcar!() によるリストの破壊的修正
上図に示すように、変数 z はリスト (1 2 3) を格納しています。setcar!() は変数 z が格納しているコンスセルの car 部を直接 4 に書き換えるので、変数 z の値も (4 2 3) になるのです。このように setcar!() には副作用があるので、immutable なリストに比べて使用には注意が必要です。
setcdr!(cell, x) はコンスセル cell の cdr 部を x に書き換えます。簡単な例を示しましょう。
julia> z = list(1, 2, 3) (1 2 3) julia> z (1 2 3) julia> setcdr!(z, 4) 4 julia> z (1 . 4)
setcdr!() はコンスセルの cdr 部、この場合は (1 2 3) の先頭セルの cdr 部を 4 に書き換えます。次の図を見てください
cdr 部を直接 4 に書き換える │ ↓ ┌─┬─┐ ┌─┬─┐ ┌─┬─┐ 変数z─→│・│・┼─→│・│・┼─→│・│/│ └┼┴─┘ └┼┴─┘ └┼┴─┘ ↓ ↓ ↓ 1 2 3 ┌─┬─┐ ┌─┬─┐ ┌─┬─┐ 変数z─→│・│・│ │・│・┼─→│・│/│ └┼┴┼┘ └┼┴─┘ └┼┴─┘ ↓ ↓ ↓ ↓ 1 4 2 3 図 : setcdr!() によるリストの破壊的修正
上図に示すように、cdr 部にはコンスセルがつながっていますが、それを 4 に書き換えるのですから後ろのコンスセルは切断されて、変数 z の値は (1 . 4) になります。setcdr!() にも副作用があることに注意してください。
今回のプログラムのポイントは、リストを生成する再帰関数を繰り返しに変換するとき、リストを破壊的に反転する関数 reverse!() を使用するところです。ここで reverse!() を動作を簡単に説明しましょう。次の図を見てください。
A B C ┌─┬─┐ ┌─┬─┐ ┌─┬─┐ 変数xs─→│a│・┼─→│b│・┼─→│c│・┼─→ () └─┴─┘ └─┴─┘ └─┴─┘ ↑ 変数ys─→ () ─┘書き換える (1) セル A の cdr 部を書き換える
B C ┌─┬─┐ ┌─┬─┐ 変数xs─→│b│・┼─→│c│・┼─→ () └─┴─┘ └─┴─┘ ↑ A──┘書き換える ┌─┬─┐ 変数ys─→│a│・┼─→ () └─┴─┘ (2) セル B の cdr 部を書き換える C ┌─┬─┐ 変数xs─→│c│・┼─→ () └─┴─┘ ↑ B──┘書き換える ┌─┬─┐ ┌─┬─┐ 変数ys─→│b│・┼─→│a│・┼─→ () └─┴─┘ └─┴─┘ (3) セル C の cdr 部を書き換える 変数xs ─→ () C B A ┌─┬─┐ ┌─┬─┐ ┌─┬─┐ 変数ys─→│c│・┼─→│b│・┼─→│a│・┼─→ () └─┴─┘ └─┴─┘ └─┴─┘ (4) 完成 図 : reverse!() の動作
変数 xs に格納されたリストを逆順にします。このとき、変数 ys に逆順のリストを保持します。考え方は簡単で、リストの先頭から要素を順番に取り出して、変数 ys のリストに追加していくところは reverse() と同じです。この操作をセルをつなぎかえることで行っているのが reverse!() です。つまり、セルごと要素を移動しているのです。
これをプログラムすると次のようになります。
リスト : リストの反転 (破壊的操作) function reverse!(xs::List) ys = nil while !null(xs) zs = cdr(xs) setcdr!(xs, ys) ys = xs xs = zs end ys end
引数 xs のリストを破壊的な操作で要素を逆順にします。変数 ys に逆順のリストを保持します。xs が空リストの場合は ys を返します。そうでなければ、xs の先頭のセルを r に追加します。
まず、2 番目のセルを変数 zs にセットします。それから、先頭セルの cdr 部を ys に書き換えます。これで、ys の先頭にセルを移動することができます。そして、ys を xs に書き換えます。これで ys に逆順のリストがセットされます。最後に、xs を zs に書き換えるだけです。
それでは簡単な例を示しましょう。
julia> a = iota(1 : 9) (1 2 3 4 5 6 7 8 9) julia> b = reverse!(a) (9 8 7 6 5 4 3 2 1) julia> b (9 8 7 6 5 4 3 2 1) julia> a (1)
reverse!() の返り値を代入した変数 b の値は逆順のリストになっています。ところが、変数 a の値は逆順のリストになっていません。reverse!() は変数 a のリストを破壊的に修正しますが、変数 a の値が逆順のリストになるわけではありません。これは Lisp の関数 nreverse や scheme の関数 reverse! と同じです。
Common Lisp の場合、nreverse の実装方法は仕様で定められているわけではないので、リストを反転したあと必ずしも先頭のセルが末尾セルになるとは限りません。実際、CLISP という処理系で (nreverse a) を評価すると、変数 a の値は反転したリストになります。他の処理系、たとえば SBCL や Scheme の Gauche では、今回の reverse!() と同じ結果になります。ご注意くださいませ。
連結リストは先頭にデータを追加したり、先頭からデータを取り除く操作は O(1) で行うことができます。たとえば、リストを反転する reverse() は簡単に繰り返しに変換できます。
リスト : リストの反転 # 再帰版 function reverse(xs::List, ys::List = nil) if atom(xs) ys else reverse(cdr(xs), cons(car(xs), ys)) end end # 繰り返し版 function reverse(xs::List) ys = nil while consp(xs) ys = cons(car(xs), ys) xs = cdr(xs) end ys end
再帰版は末尾再帰になっているので、末尾再帰最適化を行う処理系では繰り返しに変換されますが、Julia はまだサポートされていません。繰り返し版は xs の先頭から要素を取り出して、ys の先頭に追加していくだけです。では次に、リストをコピーする関数を繰り返しに変換することを考えてみましょう。
リスト : リストのコピー (再帰版) function copylist(xs::List) if atom(xs) xs else cons(car(xs), copy(cdr(xs))) end end
setcdr!() を使ってセルを後ろにつなげていく方法もありますが、けっこう面倒です。一番簡単な方法は reverse!() を使うことです。
リスト : リストのコピー (2) copylist(xs::List) = reverse!(reverse(xs))
reverse(xs) で xs の逆順のリストを生成し、reverse!() でそれを破壊的に反転します。コンスセルの消費量は同じで、スタックオーバーフローも発生しません。そのかわり、reverse!() でコンスセルをつなぎかえていくので、実行時間は余分にかかることになります。ようするに、実行効率には目をつぶって堅牢性を優先しているわけです。Mulist ではこの方法を使って再帰呼び出しを繰り返しに修正しています。
もう一つ、リストを連結するときにも reverse!() を使っています。
リスト : リストの連結 function append1(xs::List, ys::List) if atom(xs) ys else zs1 = reverse(xs) zs2 = reverse!(zs1) setcdr!(zs1, ys) zs2 end end
関数 append1() は xs と ys を連結します。reverse(xs) で xs を反転したリストを生成して、変数 zs1 にセットします。次に、reverse!(zs1) で zs1 を破壊的に反転して変数 zs2 にセットします。今回の reverse!() の動作では、変数 zs1 のセルは末尾セルになるので、setcdr!() で zs1 の cdr 部を ys に書き換えれば、xs と ys を連結した新しいリストを生成することができます。
もちろん、これは reverse!() の動作に依存したプログラムなので、reverse!() を変更すると正常に動作しなくなる可能性があります。末尾のセルを求める関数 lastpair() を使って、zs = reverse!(reverse(xs)); setcdr!(lastpair(zs), ys); zs としたほうが素直なプログラムだと思いますが、今回はこの方法も使っています。興味のある方はプログラムリストをお読みくださいませ。
julia> nil ()
julia> cons(1, 2) (1 . 2) julia> xs = cons(1, cons(2, cons(3, nil))) (1 2 3) julia> car(xs) 1 julia> cdr(xs) (2 3) julia> car(nil) () julia> cdr(nil) () julia> a = cons(1, 2) (1 . 2) julia> setcar!(a, 10) 10 julia> a (10 . 2) julia> setcdr!(a, 20) 20 julia> a (10 . 20)
julia> null(nil) true julia> null(cons(1, nil)) false julia> consp(nil) false julia> consp(cons(1, nil)) true julia> atom(1) true julia> atom(cons(1, nil)) false julia> atom(nil) true julia> listp(cons(1, nil)) true julia> listp(nil) true julia> listp(1) false julia> xs (1 2 3) julia> equal(xs, cons(1, cons(2, cons(3, nil)))) true julia> equal(xs, cons(1, cons(2, nil))) false julia> equal(xs, cons(1, cons(2, cons(4, nil)))) false julia> a = cons(1, nil) (1) julia> iscircle(a) false julia> setcdr!(a, a); nil # 循環リストを表示すると無限ループになる () julia> iscircle(a) true julia> iscircle(cons(1, 2)) false
julia> list("foo", "bar", "baz") (foo bar baz) julia> makelist(10, 0) (0 0 0 0 0 0 0 0 0 0) julia> tabulate(x -> x * x, 1 : 10) (1 4 9 16 25 36 49 64 81 100) julia> iota(1 : 2 : 10) (1 3 5 7 9) julia> xs = [1, 2, 3, 4, 5] 5-element Vector{Int64}: 1 2 3 4 5 julia> tolist(xs) (1 2 3 4 5) julia> ys = circularlist(1,2,3); nil () julia> iscircle(ys) true julia> car(ys) 1 julia> car(cdr(ys)) 2 julia> car(cdr(cdr(ys))) 3 julia> car(cdr(cdr(cdr(ys)))) 1
julia> xs = iota(0 : 9) (0 1 2 3 4 5 6 7 8 9) julia> first(xs) 0 julia> second(xs) 1 julia> third(xs) 2 julia> fourth(xs) 3 julia> fifth(xs) 4 julia> last(xs) 9 julia> lastpair(xs) (9) julia> nth(xs, 1) 0 julia> nth(xs, 2) 1 julia> nth(xs, 10) 9
julia> xs (0 1 2 3 4 5 6 7 8 9) julia> length(xs) 10 julia> a = list(1, 2, 3); b = list(4, 5, 6); c = list(7, 8, 9) (7 8 9) julia> append(a, b, c) (1 2 3 4 5 6 7 8 9) julia> a (1 2 3) julia> b (4 5 6) julia> c (7 8 9) julia> append!(a, b, c) (1 2 3 4 5 6 7 8 9) julia> a (1 2 3 4 5 6 7 8 9) julia> b (4 5 6 7 8 9) julia> c (7 8 9) julia> reverse(a) (9 8 7 6 5 4 3 2 1) julia> a (1 2 3 4 5 6 7 8 9) julia> b = reverse!(a) (9 8 7 6 5 4 3 2 1) julia> a (1) julia> b (9 8 7 6 5 4 3 2 1) julia> take(xs, 5) (0 1 2 3 4) julia> drop(xs, 5) (5 6 7 8 9) julia> takewhile(x -> x < 5, xs) (0 1 2 3 4) julia> dropwhile(x -> x < 5, xs) (5 6 7 8 9) julia> ys = list(1, list(2, list(3, list(4, 5), 6), 7), 8) (1 (2 (3 (4 5) 6) 7) 8) julia> flatten(ys) (1 2 3 4 5 6 7 8)
julia> xs = list(1, 2, 1, 2, 3, 1, 2, 3, 4, 1, 2, 3, 4, 5) (1 2 1 2 3 1 2 3 4 1 2 3 4 5) julia> member(4, xs) (4 1 2 3 4 5) julia> member(6, xs) () julia> member(x -> x % 3 == 0, xs) (3 1 2 3 4 1 2 3 4 5) julia> member(x -> x % 7 == 0, xs) () julia> 1 in xs true julia> 5 in xs true julia> 0 in xs false julia> findfirst(isequal(3), xs) 5 julia> findfirst(isequal(6), xs) julia> findnext(isequal(4), xs, 1) 9 julia> findnext(isequal(4), xs, 10) 13 julia> findnext(isequal(4), xs, 14) julia> count(x -> x == 1, xs) 4 julia> count(x -> x % 2 == 0, xs) 6 julia> count(x -> x == 7, xs) 0
julia> xs = tolist(0 : 9) (0 1 2 3 4 5 6 7 8 9) julia> map(x -> x * x, xs) (0 1 4 9 16 25 36 49 64 81) julia> map(+, list(1, 2, 3, 4), list(5, 6, 7, 8)) (6 8 10 12) julia> filter(x -> x % 2 == 0, xs) (0 2 4 6 8) julia> ys = tolist(0 : 9) (0 1 2 3 4 5 6 7 8 9) julia> zs = filter!(isodd, ys) (1 3 5 7 9) julia> ys (0 1 3 5 7 9) julia> zs (1 3 5 7 9) julia> remove(x -> x % 2 == 0, xs) (1 3 5 7 9) julia> remove(isequal(5), xs) (0 1 2 3 4 6 7 8 9) julia> ys = tolist(0 : 9) (0 1 2 3 4 5 6 7 8 9) julia> zs = remove!(iseven, ys) (1 3 5 7 9) julia> ys (0 1 3 5 7 9) julia> zs (1 3 5 7 9) julia> foldl(+, xs, 0) 45 julia> foldr(+, xs, 0) 45 julia> foldl((x, y) -> cons(y, x), xs, nil) (9 8 7 6 5 4 3 2 1 0) julia> foldr(cons, xs, nil) (0 1 2 3 4 5 6 7 8 9) julia> unfold(x -> x > 10, x -> x + 1, 1) (1 2 3 4 5 6 7 8 9 10) julia> unfold(x -> x > 10, x -> x + 1, 1, x -> 2x) (2 4 6 8 10 12 14 16 18 20) julia> foreach(println, xs) 0 1 2 3 4 5 6 7 8 9
julia> xs = iota(1 : 2 : 20) (1 3 5 7 9 11 13 15 17 19) julia> for x = xs; print("$x "); end 1 3 5 7 9 11 13 15 17 19 julia> for (i, x) = enumerate(xs); print("($i, $x)"); end (1, 1)(2, 3)(3, 5)(4, 7)(5, 9)(6, 11)(7, 13)(8, 15)(9, 17)(10, 19) julia> for x = zip(list(1,2,3), list(4,5,6), list(7,8,9)) println(x) end (1, 4, 7) (2, 5, 8) (3, 6, 9) julia> map(tuple, list(1, 2, 3), list(4, 5, 6), list(7, 8, 9)) ((1, 4, 7) (2, 5, 8) (3, 6, 9)) julia> all(x -> x % 2 == 0, list(2, 4, 6, 8, 10)) true julia> all(x -> x % 2 == 0, list(2, 4, 6, 8, 10, 11)) false julia> any(x -> x % 2 != 0, list(2, 4, 6, 8, 10, 11)) true julia> any(x -> x % 2 != 0, list(2, 4, 6, 8, 10)) false
julia> xs = list(1, 2, 3, 4, 5) (1 2 3 4 5) julia> substitute(iseven, 0, xs) (1 0 3 0 5) julia> xs (1 2 3 4 5) julia> ys = substitute!(iseven, 0, xs) (1 0 3 0 5) julia> xs (1 0 3 0 5) julia> ys (1 0 3 0 5) julia> ys = list(1, list(2, list(3, list(4, 5), 6), 7), 8) (1 (2 (3 (4 5) 6) 7) 8) julia> substitute(x -> typeof(x) == Int && x % 2 == 0, 0, ys) (1 (2 (3 (4 5) 6) 7) 0) julia> subst(x -> typeof(x) == Int && x % 2 == 0, 0, ys) (1 (0 (3 (0 5) 0) 7) 0) julia> ys (1 (2 (3 (4 5) 6) 7) 8) julia> subst!(x -> typeof(x) == Int && x % 2 == 0, 0, ys) (1 (0 (3 (0 5) 0) 7) 0) julia> ys (1 (0 (3 (0 5) 0) 7) 0)
julia> merge(list(1, 3, 5, 7, 9), list(2, 4, 6, 8, 10)) (1 2 3 4 5 6 7 8 9 10) julia> mergesort(list(5, 6, 4, 7, 3, 8, 2, 9, 1, 0)) (0 1 2 3 4 5 6 7 8 9) julia> mergesort(list(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)) (0 1 2 3 4 5 6 7 8 9) julia> mergesort(list(9, 8, 7, 6, 5, 4, 3, 2, 1, 0)) (0 1 2 3 4 5 6 7 8 9) julia> a = list(1,3,5,7,9) (1 3 5 7 9) julia> b = list(2,4,6,8,10) (2 4 6 8 10) julia> merge!(a, b) (1 2 3 4 5 6 7 8 9 10) julia> a (1 2 3 4 5 6 7 8 9 10) julia> b (2 3 4 5 6 7 8 9 10) julia> a = list(5,6,4,7,3,8,2,9,1,0) (5 6 4 7 3 8 2 9 1 0) julia> mergesort!(a) (0 1 2 3 4 5 6 7 8 9) julia> a (5 6 7 8 9) julia> a = list(0,1,2,3,4,5,6,7,8,9) (0 1 2 3 4 5 6 7 8 9) julia> mergesort!(a) (0 1 2 3 4 5 6 7 8 9) julia> a (0 1 2 3 4 5 6 7 8 9) julia> a = list(9,8,7,6,5,4,3,2,1,0) (9 8 7 6 5 4 3 2 1 0) julia> mergesort!(a) (0 1 2 3 4 5 6 7 8 9) julia> a (9)
julia> xs = pairlis(list(:a, :b, :c, :d), list(1, 2, 3, 4)) ((a . 1) (b . 2) (c . 3) (d . 4)) julia> assoc(:a, xs) (a . 1) julia> assoc(:d, xs) (d . 4) julia> assoc(:e, xs) () julia> ys = acons(:e, 5, xs) ((e . 5) (a . 1) (b . 2) (c . 3) (d . 4)) julia> assoc(:e, ys) (e . 5)
julia> unique(list(1, 2, 1, 2, 3, 1, 2, 3, 4, 1, 2, 3, 4, 5)) (1 2 3 4 5) julia> xs = list(1, 2, 3, 4) (1 2 3 4) julia> ys = list(3, 4, 5, 6) (3 4 5 6) julia> union(xs, ys) (1 2 3 4 5 6) julia> intersect(xs, ys) (3 4) julia> difference(xs, ys) (1 2) julia> issubset(list(1,2), xs) true julia> issubset(list(1,5), xs) false julia> issubset(nil, xs) true julia> issubset(xs, xs) true julia> product() (()) julia> product(list(1, 2, 3)) ((1) (2) (3)) julia> product(list(1, 2, 3), list(4, 5, 6)) ((1 4) (1 5) (1 6) (2 4) (2 5) (2 6) (3 4) (3 5) (3 6)) julia> product(list(1, 2, 3), list(4, 5, 6), list(7, 8, 9)) ((1 4 7) (1 4 8) (1 4 9) (1 5 7) (1 5 8) (1 5 9) (1 6 7) (1 6 8) (1 6 9) (2 4 7) (2 4 8) (2 4 9) (2 5 7) (2 5 8) (2 5 9) (2 6 7) (2 6 8) (2 6 9) (3 4 7) (3 4 8) (3 4 9) (3 5 7) (3 5 8) (3 5 9) (3 6 7) (3 6 8) (3 6 9)) julia> product(list(1, 2), list(3, 4), list(5, 6), list(7, 8)) ((1 3 5 7) (1 3 5 8) (1 3 6 7) (1 3 6 8) (1 4 5 7) (1 4 5 8) (1 4 6 7) (1 4 6 8) (2 3 5 7) (2 3 5 8) (2 3 6 7) (2 3 6 8) (2 4 5 7) (2 4 5 8) (2 4 6 7) (2 4 6 8))
# # Mulist.jl : Lisp ライクで mutable な連結リスト # # Copyright (C) 2018-2021 Makoto Hiroi # module Mulist export List, nil, car, cdr, setcar!, setcdr!, cons, null, listp, consp, atom, equal export list, makelist, tabulate, iota, tolist, nth, second, third, fourth, fifth export lastpair, append, take, drop, takewhile, dropwhile, flatten, remove, remove! export unfold, member, mergesort, mergesort!, acons, assoc, pairlis, difference export substitute, subst, substitute!, subst!, iscircle, circularlist, product # 多重定義用 import Base: show, iterate, first, last, length, append!, reverse, reverse! import Base: map, filter, filter!, foldl, foldr, foreach, in, findfirst import Base: findnext, merge, merge!, union, intersect, issubset, unique # # リストの定義 # abstract type List end # 空リスト struct Nil <: List end # 終端 const nil = Nil() # コンスセル mutable struct Cons <: List car cdr end # # 基本関数と述語 # car(xs::Cons) = xs.car car(xs::Nil) = nil cdr(xs::Cons) = xs.cdr cdr(xs::Nil) = nil cons(x, y) = Cons(x, y) # 書き換え setcar!(xs::Cons, x) = xs.car = x setcdr!(xs::Cons, x) = xs.cdr = x # 述語 null(xs) = xs === nil atom(xs) = typeof(xs) != Cons consp(xs) = typeof(xs) == Cons listp(xs) = null(xs) || consp(xs) # 等値の判定 function equal(xs, ys) while consp(xs) && consp(ys) if !equal(car(xs), car(ys)) return false end xs = cdr(xs) ys = cdr(ys) end xs == ys end # 循環リストの判定 function iscircle(xs::List) fast = xs slow = xs while true fast = cdr(fast) if atom(fast) return false end fast = cdr(fast) slow = cdr(slow) if atom(fast) return false elseif fast === slow return true end end end # 表示 function print_list(io::IO, xs::List) print(io, "(") while consp(xs) x = car(xs) if consp(x) print_list(io, x) elseif null(x) print(io, "()") else print(io, x) end xs = cdr(xs) if consp(xs); print(io, " "); end end if !null(xs); print(io, " . $xs"); end print(io, ")") end show(io::IO, xs::List) = print_list(io, xs) # # イテレータ # function iterate(xs::List, state = xs) if null(state) nothing else (car(state), cdr(state)) end end # # 参照 # function nth(xs::List, n::Int) while consp(xs) && n > 1 xs = cdr(xs) n -= 1 end if consp(xs) car(xs) else throw(BoundsError(xs, n)) end end first(xs::Cons) = xs.car second(xs::Cons) = xs.cdr.car third(xs::Cons) = xs.cdr.cdr.car fourth(xs::Cons) = xs.cdr.cdr.cdr.car fifth(xs::Cons) = xs.cdr.cdr.cdr.cdr.car # 末尾のセルを返す function lastpair(xs::Cons) while consp(cdr(xs)) xs = cdr(xs) end xs end # 末尾の要素 function last(xs::Cons) car(lastpair(xs)) end # # リストの生成 # list(args...) = foldr(cons, args, init = nil) function makelist(n::Int, x) xs = nil for _ = 1 : n xs = cons(x, xs) end xs end function tolist(xs::AbstractVector{T}) where {T} ys = nil for i = length(xs): -1 : 1 ys = cons(xs[i], ys) end ys end tabulate(f::Function, x::AbstractRange) = tolist(map(f, x)) iota(x::AbstractRange) = tolist(x) # 循環リストの生成 function circularlist(args...) xs = foldr(cons, args, init = nil) if consp(xs) setcdr!(lastpair(xs), xs) end xs end # # 基本的なリスト操作 # # リストの連結 function append(xs::List...) function append1(xs::List, ys::List) if atom(xs) ys else zs1 = reverse(xs) zs2 = reverse!(zs1) setcdr!(zs1, ys) zs2 end end n = length(xs) if n == 0 nil elseif n == 1 xs[1] else foldr(append1, xs) # 後ろからつなげていく end end # 破壊的 function append!(xs::List...) function nconc(xs::List, ys::List) if atom(xs) ys elseif atom(ys) xs else setcdr!(lastpair(xs), ys) xs end end n = length(xs) if n == 0 nil elseif n == 1 xs[1] else foldr(nconc, xs) end end # リストの反転 function reverse(xs::List) ys = nil while consp(xs) ys = cons(car(xs), ys) xs = cdr(xs) end ys end # 破壊的 function reverse!(xs::List) ys = nil while consp(xs) zs = cdr(xs) setcdr!(xs, ys) ys = xs xs = zs end ys end # リストの長さ function length(xs::List) c = 0 while consp(xs) c += 1 xs = cdr(xs) end c end # 先頭から要素を取り出す function take(xs::List, n::Int) ys = nil while !null(xs) && n > 0 ys = cons(car(xs), ys) xs = cdr(xs) n -= 1 end reverse!(ys) end function takewhile(pred::Function, xs::List) ys = nil while consp(xs) && pred(car(xs)) ys = cons(car(xs), ys) xs = cdr(xs) end reverse!(ys) end # 先頭から要素を取り除く function drop(xs::List, n::Int) while consp(xs) && n > 0 xs = cdr(xs) n -= 1 end xs end function dropwhile(pred::Function, xs::List) while consp(xs) && pred(car(xs)) xs = cdr(xs) end xs end # 平坦化 function flatten(xs::List) function flat(xs, a::List) if null(xs) a elseif atom(xs) cons(xs, a) else flat(car(xs), flat(cdr(xs), a)) end end flat(xs, nil) end # # 基本的な高階関数 # # マッピング function map(f::Function, xs::List...) ys = nil while all(consp, xs) ys = cons(f(map(car, xs)...), ys) xs = map(cdr, xs) end reverse!(ys) end # フィルター function filter(pred::Function, xs::List) ys = nil for x = xs if pred(x) ys = cons(x, ys) end end reverse!(ys) end function remove(pred::Function, xs::List) ys = nil for x = xs if !pred(x) ys = cons(x, ys) end end reverse!(ys) end # 破壊的 function filter!(pred::Function, xs::List) xs = dropwhile(x -> !pred(x), xs) if null(xs) return nil end ps = xs qs = cdr(xs) while consp(qs) if pred(car(qs)) setcdr!(ps, qs) ps = qs end qs = cdr(qs) end setcdr!(ps, nil) xs end function remove!(pred::Function, xs::List) xs = dropwhile(x -> pred(x), xs) if null(xs) return nil end ps = xs qs = cdr(xs) while consp(qs) if !pred(car(qs)) setcdr!(ps, qs) ps = qs end qs = cdr(qs) end setcdr!(ps, nil) xs end # 畳み込み function foldl(f::Function, xs::List, a) while consp(xs) a = f(a, car(xs)) xs = cdr(xs) end a end function foldr(f::Function, xs::List, a) xs = reverse(xs) while consp(xs) a = f(car(xs), a) xs = cdr(xs) end a end # 逆畳み込み function unfold(cond::Function, iter::Function, seed, func::Function = identity) xs = nil while !cond(seed) xs = cons(func(seed), xs) seed = iter(seed) end reverse!(xs) end # 巡回 function foreach(f::Function, xs::List) while consp(xs) f(car(xs)) xs = cdr(xs) end end # # 探索 # function member(pred::Function, xs::List) while consp(xs) if pred(car(xs)) break end xs = cdr(xs) end xs end function member(y, xs::List, op = equal) while consp(xs) if op(car(xs), y) break end xs = cdr(xs) end xs end # とりあえず missing は考慮しない function in(x, xs::List) !null(member(x, xs)) end function findfirst(pred::Function, xs::List) i = 1 while consp(xs) if pred(car(xs)) return i end i += 1 xs = cdr(xs) end nothing end function findnext(pred::Function, xs::List, i::Int) idx = findfirst(pred, drop(xs, i - 1)) if idx === nothing nothing else idx + i - 1 end end # # 置換 # function substitute(pred::Function, y, xs::List) zs = nil while consp(xs) x = car(xs) zs = cons(pred(x) ? y : x, zs) xs = cdr(xs) end reverse!(zs) end # 木の置換 function subst(pred::Function, y, xs) if pred(xs) y elseif atom(xs) xs else cons(subst(pred, y, car(xs)), subst(pred, y, cdr(xs))) end end # 破壊的 function substitute!(pred::Function, y, xs::List) ys = xs while consp(ys) if pred(car(ys)) setcar!(ys, y) end ys = cdr(ys) end xs end function subst!(pred::Function, y, xs) if pred(xs) y elseif atom(xs) xs else setcar!(xs, subst!(pred, y, car(xs))) setcdr!(xs, subst!(pred, y, cdr(xs))) xs end end # # マージとソート # # マージ function merge(xs::List, ys::List, f = <=) if null(xs) return ys end if null(ys) return xs end zs1 = nil while !null(xs) && !null(ys) x = car(xs) y = car(ys) if f(x, y) zs1 = cons(x, zs1) xs = cdr(xs) else zs1 = cons(y, zs1) ys = cdr(ys) end end zs2 = reverse!(zs1) setcdr!(zs1, null(xs) ? ys : xs) zs2 end # マージソート function mergesort(xs::List, f = <=) function sort(xs::List, n::Int) if n == 1 list(car(xs)) elseif n == 2 x = car(xs) y = car(cdr(xs)) f(x, y) ? list(x, y) : list(y, x) else m = div(n, 2) merge(sort(xs, m), sort(drop(xs, m), n - m), f) end end sort(xs, length(xs)) end # 破壊的 function merge!(xs::List, ys::List, f = <=) if null(xs) return ys end if null(ys) return xs end if f(car(xs), car(ys)) zs = xs xs = cdr(xs) else zs = ys ys = cdr(ys) end top = zs while !null(xs) && !null(ys) if f(car(xs), car(ys)) setcdr!(zs, xs) zs = xs xs = cdr(xs) else setcdr!(zs, ys) zs = ys ys = cdr(ys) end end if atom(xs) setcdr!(zs, ys) else setcdr!(zs, xs) end top end function mergesort!(xs::List, f = <=) function sort(xs::List, n::Int) if n == 1 setcdr!(xs, nil) xs else m = div(n, 2) ys = drop(xs, m) merge!(sort(xs, m), sort(ys, n - m), f) end end sort(xs, length(xs)) end # # 連想リスト # acons(key, val, alist::List) = cons(cons(key, val), alist) assoc(key, xs::List) = car(member(ys -> equal(key, car(ys)), xs)) function pairlis(xs::List, ys::List, zs = nil) ps1 = nil while consp(xs) && consp(ys) ps1 = cons(cons(car(xs), car(ys)), ps1) xs = cdr(xs) ys = cdr(ys) end if consp(ps1) ps2 = reverse!(ps1) setcdr!(ps1, zs) ps2 else zs end end # # 集合演算 # # 重複要素の削除 function unique(xs::List) ys = nil while consp(xs) x = car(xs) if !(x in ys) ys = cons(x, ys) end xs = cdr(xs) end reverse!(ys) end # 和集合 function union(xs::List, ys::List) if null(xs) return ys end zs1 = nil while consp(xs) x = car(xs) if !(x in ys) zs1 = cons(x, zs1) end xs = cdr(xs) end zs2 = reverse!(zs1) setcdr!(zs1, ys) zs2 end # 積集合 function intersect(xs::List, ys::List) zs = nil while consp(xs) x = car(xs) if x in ys zs = cons(x, zs) end xs = cdr(xs) end reverse!(zs) end # 差集合 function difference(xs::List, ys::List) zs = nil while consp(xs) x = car(xs) if !(x in ys) zs = cons(x, zs) end xs = cdr(xs) end reverse!(zs) end # 部分集合の判定 function issubset(xs::List, ys::List) while consp(xs) if !(car(xs) in ys) return false end xs = cdr(xs) end true end # 直積集合 function product(args::List...) if length(args) == 0 list(nil) else xs = map(x -> list(x), args[end]) for i = length(args) - 1: -1 : 1 xs = append!(map(y -> map(zs -> cons(y, zs), xs), args[i])...) end xs end end end