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 に書き換える
│
↓
┌─┬─┐ ┌─┬─┐ ┌─┬─┐
変数ｚ─→│・│・┼─→│・│・┼─→│・│／│
└┼┴─┘ └┼┴─┘ └┼┴─┘
↓ ↓ ↓
１ ２ ３
┌─┬─┐ ┌─┬─┐ ┌─┬─┐
変数ｚ─→│・│・┼─→│・│・┼─→│・│／│
└┼┴─┘ └┼┴─┘ └┼┴─┘
↓ ↓ ↓
４ ２ ３
図 : 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 に書き換える
│
↓
┌─┬─┐ ┌─┬─┐ ┌─┬─┐
変数ｚ─→│・│・┼─→│・│・┼─→│・│／│
└┼┴─┘ └┼┴─┘ └┼┴─┘
↓ ↓ ↓
１ ２ ３
┌─┬─┐ ┌─┬─┐ ┌─┬─┐
変数ｚ─→│・│・│ │・│・┼─→│・│／│
└┼┴┼┘ └┼┴─┘ └┼┴─┘
↓ ↓ ↓ ↓
１ ４ ２ ３
図 : setcdr!() によるリストの破壊的修正
上図に示すように、cdr 部にはコンスセルがつながっていますが、それを 4 に書き換えるのですから後ろのコンスセルは切断されて、変数 z の値は (1 . 4) になります。setcdr!() にも副作用があることに注意してください。
今回のプログラムのポイントは、リストを生成する再帰関数を繰り返しに変換するとき、リストを破壊的に反転する関数 reverse!() を使用するところです。ここで reverse!() を動作を簡単に説明しましょう。次の図を見てください。
A B C
┌─┬─┐ ┌─┬─┐ ┌─┬─┐
変数xs─→│ａ│・┼─→│ｂ│・┼─→│ｃ│・┼─→ ()
└─┴─┘ └─┴─┘ └─┴─┘
↑
変数ys─→ () ─┘書き換える
(1) セル A の cdr 部を書き換える
B C
┌─┬─┐ ┌─┬─┐
変数xs─→│ｂ│・┼─→│ｃ│・┼─→ ()
└─┴─┘ └─┴─┘
↑
A──┘書き換える
┌─┬─┐
変数ys─→│ａ│・┼─→ ()
└─┴─┘
(2) セル B の cdr 部を書き換える
C
┌─┬─┐
変数xs─→│ｃ│・┼─→ ()
└─┴─┘
↑
B──┘書き換える
┌─┬─┐ ┌─┬─┐
変数ys─→│ｂ│・┼─→│ａ│・┼─→ ()
└─┴─┘ └─┴─┘
(3) セル C の cdr 部を書き換える
変数xs ─→ ()
C B A
┌─┬─┐ ┌─┬─┐ ┌─┬─┐
変数ys─→│ｃ│・┼─→│ｂ│・┼─→│ａ│・┼─→ ()
└─┴─┘ └─┴─┘ └─┴─┘
(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