Lisp ライクな連結リスト (mutable)
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) になることに注意してください。次の図を見てください。
上図に示すように、変数 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 . 4) になります。setcdr!() にも副作用があることに注意してください。
●リストの反転 (破壊的)
今回のプログラムのポイントは、リストを生成する再帰関数を繰り返しに変換するとき、リストを破壊的に反転する関数 reverse!() を使用するところです。ここで 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!() と同じ結果になります。ご注意くださいませ。
●Mulist での 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 としたほうが素直なプログラムだと思いますが、今回はこの方法も使っています。興味のある方は プログラムリスト をお読みくださいませ。
●連結リスト (mutable) の仕様
- モジュール名: Mulist
- データ型
- List : 連結リスト (抽象型, 公開)
- Nil : 空リスト (非公開)
- Cons : コンスセル (非公開)
- 定数
- nil : 空リスト
julia> nil ()
- 基本関数
- cons(xs, ys) : xs, ys をコンスセルに格納して返す
- car(xs) : リストの先頭要素を返す
- cdr(xs) : リストの先頭要素をを取り除いたリストを返す
- setcar!(xs, x) : コンスセルの car を x に書き換える
- setcdr!(xs, x) : コンスセルの cdr を x に書き換える
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)
- 述語
- null(xs) : xs が nil ならば true を返す
- consp(xs) : xs がコンスセル (Cons) ならば true を返す
- atom(xs) : xs がコンスセルでなければ true を返す
- listp(xs) : xs がコンスセルまたは空リストならば true を返す
- equal(xs, ys) : xs == ys またはリストが equal() を満たすならば true を返す
- iscircle(xs) : xs が循環リストならば true を返す
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
- リストの生成
- list(x...) : 引数をリストに格納して返す
- makelist(n, x) : 要素が x で長さが n のリストを生成する
- tabulate(f, r) : 範囲オブジェクト r の要素に関数 f を適用した結果をリストに格納して返す
- iota(r) : 範囲オブジェクト r の要素をリストに格納して返す
- tolist(xs) : コンテナ xs の要素をリストに格納して返す
- circularlist(x...) : 引数を無限に繰り返すリストを生成する
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 に合わせて添字は 1 から始める
- リストはランダムアクセスできない (要素のアクセスは O(N) になる) ので、getindex() と lastindex() は実装しない
- first(xs) : car(xs) と同じ
- second(xs) : 2 番目の要素を返す
- third(xs) : 3 番目の要素を返す
- fourth(xs) : 4 番目の要素を返す
- fifth(xs) : 5 番目の要素を返す
- last(xs) : リストの最後の要素を返す
- lastpair(xs) : リストの最後のコンスセルを返す
- nth(xs, n) : リストの n 番目の要素を返す
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
- 基本的なリスト操作
- length(xs) : リスト xs の長さを求める
- append(xs...) : 引数のリストを連結したリストを返す
- append!(xs...) : append() の破壊的操作
- reverse(xs) : リスト xs を反転する
- reverse!(xs) : reverse() の破壊的操作
- take(xs, n) : リスト xs の先頭から n 個の要素を取り出す
- takewhile(pred, xs): リスト xs の先頭から関数 pred が真を返す間、それらの要素を取り出す
- drop(xs, n) : リスト xs の先頭から n 個の要素を取り除く
- dropwhile(pred, xs): リスト xs の先頭から関数 pred が真を返す間、それらの要素を取り除く
- flatten(xs) : リストの平坦化 (再帰定義)
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)
- リストの探索
- member(x, xs, op = equal) : リスト xs から x と等しい要素を探す
- 比較にはデフォルトで関数 equal を使う
- 見つけた場合、それ以降のリストを返す
- 見つからない場合は nil を返す
- member(f, xs) : member の高階関数版
- x in xs : リスト xs に x と等しい要素があれば true を返す (in(x, xs) でも OK)
- findfirst(pred, xs) : pred(x) が真となる要素 x の位置を返す, 見つからない場合は nothing を返す
- findnext(pred, xs, i) : リスト xs の i 番目から探索する
- count(f, xs) : 関数 f が真を返す要素を数える (Julia の関数)
- member(x, xs, op = equal) : リスト xs から x と等しい要素を探す
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
- 高階関数
- map(f, xs...) : マッピング
- filter(pred, xs) : xs の要素に関数 pred を適用し、真を返す要素をリストに格納して返す
- filter!(pred, xs) : filter() の破壊的操作
- remove(pred, xs) : xs の要素に関数 pred を適用し、真を返す要素をリストから削除する
- remove!(pred, xs) : remove() の破壊的操作
- foldl(f, xs, init) : リストの先頭から畳み込む
- foldr(f, xs, init) : リストの末尾から畳み込む
- unfold(cond, iter, seed, func = identity) : 逆畳み込み
- cond : cond(seed) が真のとき終了
- iter : iter(seed) で次の seed を計算する
- seed : 値
- func : seed に適用する関数 (評価結果がリストに格納される)
- identity(x) は引数 x をそのまま返す (恒等関数)
- foreach(f, xs) : リストの要素に関数 f を適用する
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
- イテレータ
- イテレータを実装しているので、それを受け取る関数ならば、たいていの場合は動作する
- ただし、getindex() や lastindex() を実装していないので、それらを使用している関数は動作しない
- zip(iter...) : イテレータから要素を取り出し、それをタプルに格納して返す (返り値はイテレータ)
- enumerate(iter) : 添字と要素を返す (返り値はイテレータ)
- all(f, iter) : イテレータの要素に関数 f を適用し、結果がすべて真ならば真を返す
- any(f, iter) : イテレータの要素に関数 f を適用し、結果がすべて偽ならば偽を返す (ひとつでも真ならば真を返す)
- その他いろいろある
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
- リストの置換
- substitute(pred, y, xs) : リスト xs のトップレベルの要素で、関数 pred が真を返す要素を y に置換する
- substitute!(pred, y, xs) : substitute() の破壊的操作
- subst(pred, y, xs) : リスト xs を木とみなして、関数 pred が真を返す要素を y に置換する (再帰定義)
- subst!(pred, y, xs) : subst() の破壊的操作 (再帰定義)
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)
- リストのマージとソート
- merge(xs, ys, op = <=) : リスト xs, ys を併合 (マージ) する
- merge!(xs, ys, op = <=) : merge() の破壊的操作
- xs, ys は op の順序で整列済みであること
- mergesort(xs, op = <=) : リスト xs をマージソートする
- mergesort!(xs, op = <=) : mergesort() の破壊的操作
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)
- 連想リスト
- acons(key, val, alist) : 連想リスト alist に (key . val) を追加
- assoc(key, alist) : 連想リスト alist から key を探す
- 見つけた場合は (key . val) を返す
- 見つからない場合は false を返す
- pairlis(keys, vals, alist = nil) : リスト keys, vals から連想リストを生成する
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)
- 集合演算
- unique(xs) : xs から重複要素を取り除いたリストを返す
- union(xs, ys) : 和集合
- intersect(xs, ys) : 積集合
- difference(xs, ys) : 差集合
- issubset(xs, ys) : xs が ys の部分集合ならば真を返す
- product(xs...) : 直積集合
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
2021/12/05 改訂: Julia のバージョンを 1.6 に変更