2 つのリスト xs, ys を受け取り、同じ位置にある要素をリストにまとめ、それをリストに格納して返す関数 zip1 xs ys を定義してください。引数のリストの長さが異なる場合は、短いリストの長さに合わせてください。SRFI-1 の map を使うと簡単に定義できますが、ここでは map を使わないものとします。
gosh> (zip1 '(a b c d) '(1 2 3 4)) ((a 1) (b 2) (c 3) (d 4)) gosh> (zip1 '(a b c d) '(1 2 3)) ((a 1) (b 2) (c 3)) gosh> (zip1 '(a b c) '(1 2 3 4)) ((a 1) (b 2) (c 3)) gosh> (zip1 '(a b c) '()) ()
2 つ以上のリストを受け取り、同じ位置にある要素をリストにまとめ、それをリストに格納して返す関数 zipN xs1 xs2 ... を定義してください。引数のリストの長さが異なる場合は、短いリストの長さに合わせてください。ただし、SRFI-1 の map は使わないで、次に示すマップ関数 map1 を使ってください。なお、SRFI-1 には同等の動作をおこうなう関数 zip が用意されています。
リスト : マップ関数
(define (map1 f xs)
(if (null? xs)
'()
(cons (f (car xs)) (map1 f (cdr xs)))))
gosh> (zipN '(a b c) '(1 2 3) '(4 5 6)) ((a 1 4) (b 2 5) (c 3 6)) gosh> (zipN '(a b c) '(1 2 3) '(4 5)) ((a 1 4) (b 2 5))
zip したリストを元に戻す関数 unzip xs を定義してください。返り値のリストは多値で返すものとします。なお、SRFI-1 には同等の動作を行う関数 unzip1 が用意されています。
gosh> (unzip '((a 1) (b 2) (c 3) (d 4))) (a b c d) (1 2 3 4)
zipN したリストを元に戻す関数 unzipN xs を定義してください。返り値のリストは多値で返すものとします。
gosh> (unzipN '((a 1 11) (b 2 12) (c 3 13) (d 4 14))) (a b c d) (1 2 3 4) (11 12 13 14)
関数 takeWhile pred xs は述語 pred を満たす要素が続いている間、リスト xs の先頭から順番に要素を取り出します。関数 takeWhile を定義してください。SRFI-1 には同等の動作を行う関数 take-while が定義されているので、関数名を takeWhile としました。
gosh> (takeWhile even? '(2 4 6 8 1 2 3 4)) (2 4 6 8) gosh> (takeWhile odd? '(2 4 6 8 1 2 3 4)) ()
関数 dropWhile pred xs は述語 pred を満たす要素が続いている間、リスト xs の先頭から順番に要素を取り除きます。関数 dropWhile を定義してください。SRFI-1 には同等の動作を行う関数 drop-while が定義されているので、関数名を dropWhile としました。
gosh> (dropWhile even? '(2 4 6 8 1 2 3 4)) (1 2 3 4) gosh> (dropWhile odd? '(2 4 6 8 1 2 3 4)) (2 4 6 8 1 2 3 4)
関数 span pred xs は (values (takeWhile pred xs) (dropWhile pred xs)) を返します。takeWhile と dropWhile を使わないで関数 span を定義してください。span は SRFI-1 に定義されているので、ここでは関数名を span1 としました。
gosh> (span1 even? '(2 4 6 8 1 2 3 4)) (2 4 6 8) (1 2 3 4) gosh> (span1 odd? '(2 4 6 8 1 2 3 4)) () (2 4 6 8 1 2 3 4)
関数 break pred xs は span とは逆の動作、つまり span (lambda (x) (not (pred x))) xs と同じ動作をします。takeWhile, dropWhile, span を使わないで関数 break を定義してください。bread は SRFI-1 に定義されているので、ここでは関数名を break1 としました。
gosh> (break1 even? '(2 4 6 8 1 2 3 4)) () (2 4 6 8 1 2 3 4) gosh> (break1 odd? '(2 4 6 8 1 2 3 4)) (2 4 6 8) (1 2 3 4)
関数 scanl f a xs は畳み込みを行う関数 fold f a xs と同じ動作をしますが、計算途中の累積値をリストに格納して返すところが異なります。関数 scanl を定義してください。
gosh> (scanl + 0 '(1 2 3 4 5 6 7 8 9 10)) (0 1 3 6 10 15 21 28 36 45 55) gosh> (display (scanl cons '() '(1 2 3 4))) (() (1) (2 1) (3 2 1) (4 3 2 1))#<undef>
関数 scanr f a xs は畳み込みを行う関数 fold-right f a xs と同じ動作をしますが、計算途中の累積値をリストに格納して返すところが異なります。関数 scanr を定義してください。
gosh> (scanr + 0 '(1 2 3 4 5 6 7 8 9 10)) (55 54 52 49 45 40 34 27 19 10 0) gosh> (display (scanr cons '() '(1 2 3 4))) ((1 2 3 4) (2 3 4) (3 4) (4) ())#<undef>
関数 map-accum-left f a xs は map と fold を合わせた関数で、畳み込みを行った結果と各要素に関数 f を適用した結果を格納したリストを多値で返します。関数 f は累積値とリストの要素を受け取り、新しい累積値とリストに格納する値を多値で返します。関数 map-accum-left を定義してください。
gosh> (map-accum-left (lambda (a x) (values (+ a (* x x)) (* x x))) 0 '(1 2 3 4 5)) 55 (1 4 9 16 25) gosh> (map-accum-left (lambda (a x) (values (+ a x) (+ a x))) 0 '(1 2 3 4 5)) 15 (1 3 6 10 15)
関数 map-accum-right f a xs は map と fold-right を合わせた関数で、畳み込みを行った結果と各要素に関数 f を適用した結果を格納したリストを多値で返します。関数 f は累積値とリストの要素を受け取り、新しい累積値とリストに格納する値を多値で返します。関数 map-accum-right を定義してください。
gosh> (map-accum-right (lambda (a x) (values (+ a (* x x)) (* x x))) 0 '(1 2 3 4 5)) 55 (1 4 9 16 25) gosh> (map-accum-right (lambda (a x) (values (+ a x) (+ a x))) 0 '(1 2 3 4 5)) 15 (15 14 12 9 5)
リスト xs の要素の間に x を挿入する関数 intersperse x xs を定義してください。
gosh> (intersperse 0 '(1 2 3 4 5)) (1 0 2 0 3 0 4 0 5) gosh> (display (intersperse '(0 0)'(1 2 3 4 5))) (1 (0 0) 2 (0 0) 3 (0 0) 4 (0 0) 5)#<undef>
リスト ys の要素の間にリスト xs を挿入して平坦化する関数 intercalate xs ys を定義してください。この場合、ys の要素はリストでなければなりません。
gosh> (intercalate '(0 0) '((a b c) (d e f) (g h i))) (a b c 0 0 d e f 0 0 g h i)
畳み込みを行う関数 fold, fold-right はリストの要素に関数が適用されますが、リストそのものを関数に渡して畳み込みを行う方法も考えられます。リストの先頭から畳み込みを行う関数 pair-fold-left と、末尾から畳み込みを行う関数 pair-fold-right を定義してください。SRFI-1 には関数 pair-fold-right が定義されているので、ここでは関数名を pair-fold-right1 としました。
gosh> (display (pair-fold-left (lambda (x a) (cons x a)) '() '(1 2 3 4 5))) ((5) (4 5) (3 4 5) (2 3 4 5) (1 2 3 4 5))#<undef> gosh> (pair-fold-left (lambda (x a) (cons (apply + x) a)) '() '(1 2 3 4 5)) (5 9 12 14 15) gosh> (display (pair-fold-right (lambda (x a) (cons x a)) '() '(1 2 3 4 5))) ((1 2 3 4 5) (2 3 4 5) (3 4 5) (4 5) (5))#<undef> gosh> (pair-fold-right (lambda (x a) (cons (apply + x) a)) '() '(1 2 3 4 5)) (15 14 12 9 5)
リスト xs の接頭辞をすべて求める関数 inits xs を定義してください。
gosh> (inits '(a b c d e)) (() (a) (a b) (a b c) (a b c d) (a b c d e))
リスト xs の接尾辞をすべて求める関数 tails xs を定義してください。
gosh> (display (tails '(a b c d e))) ((a b c d e) (b c d e) (c d e) (d e) (e) ())#<undef>
リスト xs の中で等しい要素を集めてグループに分ける関数 group-collection xs を定義してください。なお、等値関係は述語 eqv? でチェックするものとします。
gosh> (group-collection1 '(1 2 3 1 2 3 4 1 2 3 4 5 4 5 6)) ((1 1 1) (2 2 2) (3 3 3) (4 4 4) (5 5) (6)) gosh> (group-collection1 '(a b c d e f g)) ((a) (b) (c) (d) (e) (f) (g))
リスト xs に x を挿入するパターンをすべて求めてリストに格納して返す関数 interleave x xs を定義してください。
gosh> (display (interleave 0 '(1 2 3 4 5))) ((0 1 2 3 4 5) (1 0 2 3 4 5) (1 2 0 3 4 5) (1 2 3 0 4 5) (1 2 3 4 0 5) (1 2 3 4 5 0))#<undef> gosh> (display (interleave 0 '(1))) ((0 1) (1 0))#<undef> gosh> (display (interleave 0 '())) ((0))#<undef>
関数 interleave を使ってリスト xs の順列を求める関数 permutations を定義してください。なお、順列はリストに格納して返すものとします。
gosh> (display (permutations '(a b c d))) ((a b c d) (b a c d) (b c a d) (b c d a) (a c b d) (c a b d) (c b a d) (c b d a) (a c d b) (c a d b) (c d a b) (c d b a) (a b d c) (b a d c) (b d a c) (b d c a) (a d b c) (d a b c) (d b a c) (d b c a) (a d c b) (d a c b) (d c a b) (d c b a) )#<undef>
2 つのリストをひとつにまとめる場合、SRFI-1 の map を使えば (map list xs ys) で実現できます。R5RS の map は、リストの長さが同じでなければならないことに注意してください。map を使わずに再帰定義でプログラムすると、次のようになるでしょう。
リスト : 2 つのリストをひとつにまとめる
(define (zip1 xs ys)
(if (or (null? xs) (null? ys))
'()
(cons (list (car xs) (car ys)) (zip1 (cdr xs) (cdr ys)))))
; 別解
(define (zip2 xs ys)
(let loop ((xs xs) (ys ys) (a '()))
(if (or (null? xs) (null? ys))
(reverse! a)
(loop (cdr xs) (cdr ys) (cons (list (car xs) (car ys)) a)))))
xs または ys が空リストならば空リストを返します。そうでなければ、zip1 を再帰呼び出しして、その返り値に (list (car xs) (car ys)) を追加します。とても簡単ですね。別解は末尾再帰でプログラムしたものです。最後に reverse! でリストを反転することに注意してください。
複数のリストをひとつにまとめる場合、再帰呼び出しでプログラムすると次のようになります。
リスト : 複数のリストをひとつにまとめる
(define (map1 f xs)
(if (null? xs)
'()
(cons (f (car xs)) (map1 f (cdr xs)))))
(define (zipN . xs)
(if (any null? xs)
'()
(cons (map1 car xs) (apply zipN (map1 cdr xs)))))
; 別解
(define (zipN1 . xs)
(let loop ((xs xs) (a '()))
(if (any null? xs)
(reverse! a)
(loop (map1 cdr xs) (cons (map1 car xs) a)))))
述語 any でリスト xs の中に空リストがあるかチェックします。空リストがある場合は空リストを返します。そうでなければ zipN を再帰呼び出しします。このとき、map1 を使ってリストの要素 (リスト) に cdr を適用し、apply を使って zipN を評価します。その返り値に map1 で集めた先頭要素を追加します。別解は末尾再帰でプログラムしたものです。
なお、SRFI-1 の map でプログラムすると次のようになります。
リスト : SRFI-1 の map を使う場合 (define (zipN . xs) (apply map list xs))
リスト : ひとつのリストを 2 つのリストに分ける
(define (unzip xs)
(if (null? xs)
(values '() '())
(receive (a b) (unzip (cdr xs))
(values (cons (caar xs) a)
(cons (cadar xs) b)))))
; 別解 1
(define (unzip1 xs)
(let loop ((xs xs) (a '()) (b '()))
(if (null? xs)
(values (reverse! a) (reverse! b))
(loop (cdr xs) (cons (caar xs) a) (cons (cadar xs) b)))))
; 別解 2
(define (unzip2 xs)
(apply values (fold-right (lambda (x a) (map cons x a)) '(() ()) xs)))
unzip は再帰呼び出しでプログラムすると簡単です。xs が空リストの場合、2 つの空リストを values で返します。そうでなければ、unzip を再帰呼び出しして、返り値 (多値) を receive で受け取ります。そして、受け取ったリストに要素を追加して、それを values で返すだけです。
別解 1 は末尾再帰でプログラムしたものです。最後に reverse! でリストを反転しています。別解 2 は畳み込み fold-right でプログラムしたものです。
リスト : ひとつのリストを複数のリストに分ける
(define (unzipN xs)
(if (null? (cdr xs))
(apply values (map list (car xs)))
(receive ys (unzipN (cdr xs))
(apply values (map cons (car xs) ys)))))
; 別解 1
(define (unzipN1 xs)
(let loop ((xs (cdr xs)) (a (map list (car xs))))
(if (null? xs)
(apply values (map reverse! a))
(loop (cdr xs) (map cons (car xs) a)))))
; 別解 2
(define (unzipN2 xs)
(apply values
(map reverse!
(fold (lambda (x a) (map cons x a))
(map list (car xs))
(cdr xs)))))
unzipN も簡単です。xs の要素が 1 つの場合、リストの要素を分けて values で返します。これは map で各要素に list を適用すれば簡単に求めることができます。実行例を示しましょう。
gosh> (map list '(1 2 3 4 5)) ((1) (2) (3) (4) (5)) gosh> (apply values (map list '(1 2 3 4 5))) (1) (2) (3) (4) (5)
そうでなければ unzipN を再帰呼び出しして、返り値を receive で受け取ります。この場合、変数 ys の値はリストになることに注意してください。あとは map でリストに要素を追加して、それを apply values で返すだけです。
別解 1 は末尾再帰でプログラムしたものです。最後に、各リストに reverse! を適用して反転していることに注意してください。別解 2 は畳み込み fold を使ってプログラムしたものです。
リスト : pred が真の要素を取り出す
(define (takeWhile pred xs)
(if (and (pair? xs) (pred (car xs)))
(cons (car xs) (takeWhile pred (cdr xs)))
'()))
; 別解
(define (takeWhile1 pred xs)
(let loop ((xs xs) (a '()))
(if (and (pair? xs) (pred (car xs)))
(loop (cdr xs) (cons (car xs) a))
(reverse! a))))
takeWhile は xs が空リストまたは述語 pred が偽を返すとき空リストを返します。そうでなければ、takeWhile を再帰呼び出しして、その返り値にリストの要素を追加します。別解は末尾再帰でプログラムしたものです。
リスト : pred が真の要素を取り除く
(define (dropWhile pred xs)
(if (and (pair? xs) (pred (car xs)))
(dropWhile pred (cdr xs))
xs))
dropWhile は簡単です。リスト xs が空リストまたは述語 pred が偽を返すとき、リスト xs を返します。そうでなければ、dropWhile を再帰呼び出しするだけです。
リスト : pred が偽を返すところでリストを分ける
(define (span1 pred xs)
(if (and (pair? xs) (pred (car xs)))
(receive (ys zs) (span1 pred (cdr xs))
(values (cons (car xs) ys) zs))
(values '() xs)))
; 別解
(define (span2 pred xs)
(let loop ((xs xs) (a '()))
(if (and (pair? xs) (pred (car xs)))
(loop (cdr xs) (cons (car xs) a))
(values (reverse! a) xs))))
span1 は再帰呼び出しでプログラムすると簡単です。リスト xs が空リストまたは述語 pred が偽を返すときが再帰呼び出しの停止条件です。values で空リストと xs を返します。そうでなければ、span1 を再帰呼び出しして返り値を receive で受け取ります。そして、xs の先頭要素を ys に追加して、zs といっしょに values で返します。別解は末尾再帰でプログラムしたものです。
リスト : pred が真を返すところでリストを分ける
(define (break1 pred xs)
(if (or (null? xs) (pred (car xs)))
(values '() xs)
(receive (ys zs) (break1 pred (cdr xs))
(values (cons (car xs) ys) zs))))
; 別解
(define (break2 pred xs)
(let loop ((xs xs) (a '()))
(if (or (null? xs) (pred (car xs)))
(values (reverse! a) xs)
(loop (cdr xs) (cons (car xs) a)))))
break1 も再帰呼び出しでプログラムすると簡単です。リスト xs が空リストまたは述語 pred が真を返すときが再帰呼び出しの停止条件です。values で空リストと xs を返します。そうでなければ、break1 を再帰呼び出しして返り値を receive で受け取ります。そして、xs の先頭要素を ys に追加して、zs といっしょに values で返します。別解は末尾再帰でプログラムしたものです。
リスト : 累積値リストの生成
(define (scanl f a xs)
(if (null? xs)
(list a)
(cons a (scanl f (f (car xs) a) (cdr xs)))))
; 別解
(define (scanl1 f a xs)
(reverse! (fold (lambda (x a) (cons (f x (car a)) a)) (list a) xs)))
scanl はリストの最後の要素が最終の累積値になります。xs が空リストのとき、累積変数 a の値をリストに格納して返します。そうでなければ、scanl を再帰呼び出しして、その返り値に累積変数 a の値を追加して返します。scanl を再帰呼び出しするときは、関数 f を呼び出して累積変数の値を更新することに注意してください。別解は fold を使ったバージョンです。返り値のリストは逆順になるので、reverse! で反転しています。
リスト : 累積値リストの生成
(define (scanr f a xs)
(if (null? xs)
(list a)
(let ((ys (scanr f a (cdr xs))))
(cons (f (car xs) (car ys)) ys))))
; 別解
(define (scanr1 f a xs)
(fold-right (lambda (x a) (cons (f x (car a)) a)) (list a) xs))
scanr はリストの先頭の要素が最終の累積値、最後の要素が初期値になります。リスト xs が空リストの場合は (list a) を返します。そうでなければ、scanr を再帰呼び出しします。このとき、累積変数 a の値は更新しません。返り値のリストは変数 ys にセットします。この ys の先頭要素が一つ前の累積値になるので、この値と xs の要素を関数 f に渡して評価します。あとは、f の返り値を ys の先頭に追加して返せばいいわけです。別解は畳み込み fold-right を使ったバージョンです。
リスト : マッピングと畳み込み
(define (map-accum-left f acc xs)
(if (null? xs)
(values acc '())
(receive (a y) (f acc (car xs))
(receive (b ys) (map-accum-left f a (cdr xs))
(values b (cons y ys))))))
; 別解
(define (map-accum-left1 f acc xs)
(let loop ((xs xs) (a acc) (ys '()))
(if (null? xs)
(values a (reverse! ys))
(receive (b y) (f a (car xs))
(loop (cdr xs) b (cons y ys))))))
map-accum-left は fold と map を組み合わせたものです。累積値はリストの先頭から計算し、マッピングの結果は末尾から組み立てていきます。引数 acc は初期値とともに計算途中の累積値を表します。xs が空リストの場合、acc と空リストを valuse で返します。そうでなければ、関数 f に累積値 acc と要素 (car xs) を渡して評価し、新しい累積値とマッピングの値を変数 a と y にセットします。
それから、map-accum-left を再帰呼び出しします。このとき、累積値は a になることに注意してください。返り値は畳み込みの値 b とマッピングの結果を格納したリスト ys です。あとは、ys に y を追加して b と一緒に values で返すだけです。別解は末尾再帰でプログラムしたものです。マッピングの値を格納したリスト ys は逆順になっているので、reverse! で反転していることに注意してください。
リスト : マッピングと畳み込み
(define (map-accum-right f acc xs)
(if (null? xs)
(values acc '())
(receive (a ys) (map-accum-right f acc (cdr xs))
(receive (b y) (f a (car xs))
(values b (cons y ys))))))
; 別解
(define (map-accum-right1 f acc xs)
(apply values
(fold-right (lambda (x a)
(receive (b y) (f (car a) x)
(list b (cons y (cadr a)))))
(list acc '())
xs)))
map-accum-right の場合、累積値はリストの末尾から計算し、マッピングの結果も末尾から組み立てていきます。xs が空リストの場合、初期値 acc と空リストを valuse で返します。そうでなければ map-accum-right を再帰呼び出しします。初期値 acc をそのまま渡すことに注意してください。返り値は receive で受け取り、累積値が変数 a に、マッピングの値を格納したリストが変数 ys にセットされます。
次に関数 f を呼び出します。このとき、累積値 a とリストの要素 (car xs) を渡します。結果は receive で受け取り、新しい累積値が b に、マッピングの値が y にセットされます。あとは、y を ys に追加して累積値 b と一緒に values で返すだけです。別解は畳み込み fold-right を使ったバージョンです。
リスト : 要素の間にデータを挿入する
(define (intersperse x xs)
(if (or (null? xs) (null? (cdr xs)))
xs
(list* (car xs) x (intersperse x (cdr xs)))))
; 別解 1
(define (intersperse1 x xs)
(if (null? xs)
xs
(reverse! (fold (lambda (y a) (list* y x a)) (list (car xs)) (cdr xs)))))
; 別解 2
(define (intersperse2 x xs)
(if (null? xs)
xs
(cons (car xs)
(fold-right (lambda (y a) (list* x y a)) '() (cdr xs)))))
intersperse は再帰呼び出しで簡単にプログラムできます。リスト xs が空リストまたは要素がひとつしかない場合、データ x を挿入できないので xs をそのまま返します。そうでなければ、先頭の要素と次の要素の間に x を挿入します。これは関数 list* を使うと簡単です。(car xs) の次に x を挿入し、残りのリストに対して intersperse を再帰呼び出しすればいいわけです。別解は畳み込み fold と fold-right を使ったバージョンです。fold の場合、返り値のリストは逆順になるので reverse! で反転しています。
リスト : リストの要素の間にデータを挿入して平坦化する
(define (intercalate xs xss)
(apply append (intersperse xs xss)))
; 別解
(define (intercalate1 xs xss)
(cond ((null? xss) xss)
((null? (cdr xss)) (car xss))
(else
(append (car xss) xs (intercalate1 xs (cdr xss))))))
intercalate は intersperse を呼び出して xs を xss の要素の間に挿入し、その結果を apply append で平坦化するだけです。別解は intersperses を使わないで再帰呼び出しでプログラムしたものです。intersperses と違って、append でリストを連結していることに注意してください。これでリストを平坦化することができます。
リスト : 畳み込み
(define (pair-fold-left f a xs)
(if (null? xs)
a
(pair-fold-left f (f xs a) (cdr xs))))
(define (pair-fold-right1 f a xs)
(if (null? xs)
a
(f xs (pair-fold-right1 f a (cdr xs)))))
pair-fold-left と pair-fold-right は簡単です。関数 f を呼び出すときリストの要素 (car xs) の代わりに xs をそのまま渡すだけです。あとは普通の畳み込み fold, fold-right と同じです。
リスト : 接頭辞を求める (define (inits xs) (scanl (lambda (x a) (append a (list x))) '() xs)) ; 別解 (define (inits1 xs) (fold (lambda (x a) (cons (append (car a) (list x)) a)) '(()) xs))
inits は scanl を使うと簡単です。累積値 a の末尾に x を追加していくだけです。別解は fold を使ったバージョンです。
リスト : 接尾辞を求める (define (tails xs) (scanr cons '() xs)) ; 別解 (define (tails1 xs) (pair-fold-right cons '(()) xs))
inits は scanr を使うと簡単です。累積値の先頭に xs の要素を追加するだけです。別解のように pair-fold-right を使っても簡単にプログラムできます。
リスト : 等値 (eqv?) でグループに分ける
(define (group-insert x xs)
(cond ((null? xs)
(list (list x)))
((eqv? x (caar xs))
(cons (cons x (car xs)) (cdr xs)))
(else
(cons (car xs) (group-insert x (cdr xs))))))
(define (group-collection xs)
(let iter ((xs xs) (ys '()))
(if (null? xs)
ys
(iter (cdr xs) (group-insert (car xs) ys)))))
; 別解
(define (group-collection1 xs)
(fold (lambda (x a) (group-insert x a)) '() xs))
group-collection は x をグループに挿入する関数 group-insert x xs を定義すると簡単です。group-insert の引数 xs はグループ (リスト) を格納したリストです。xs が空リストの場合、x と等しい値を持つグループはなかったので新しいグループを生成して返します。グループの先頭要素 (caar xs) と x が等しい場合、そのグループに x を追加して返します。そうでなければ、group-insert を再帰呼び出しして次のグループをチェックします。
group-collection は引数 xs の要素を順番に取り出し、group-insert で該当するグループに挿入していくだけです。別解は畳み込み fold を使ったバージョンです。
リスト : データをひとつ挿入するパターンをすべて求める
(define (interleave x xs)
(if (null? xs)
(list (list x))
(append (list (cons x xs))
(map (lambda (ys) (cons (car xs) ys))
(interleave x (cdr xs))))))
; 別解
(define (reverse-append xs ys)
(fold (lambda (x a) (cons x a)) ys xs))
(define (interleave1 x xs)
(let loop ((xs xs) (ys '()) (a '()))
(if (null? xs)
(cons (reverse-append ys (list x)) a)
(loop
(cdr xs)
(cons (car xs) ys)
(cons (reverse-append ys (cons x xs)) a)))))
interleave はリスト xs の先頭に x を挿入する場合と、それ以外の場合に分けて考えます。先頭に追加するのは簡単ですね。それ以外の場合は、先頭要素を取り除いたリスト (cdr xs) に x を挿入すればいいので、interleave を再帰呼び出しすることで求めることができます。そして、その返り値のリストに先頭要素 (car xs) を追加すればいいわけです。
プログラムは簡単です。xs が空リストの場合は (list (list x)) を返します。そうでなければ、xs の先頭に x を追加したものと、(interleave x (cdr xs)) の返り値に (car xs) を追加したものを append で連結して返します。
別解はリストの先頭から順番に x の挿入位置を変えていきます。x よりも前にある要素を ys に格納しておくと、x を挿入したリストは、ys + (x) + xs で求めることができます。interleave1 の場合、ys は逆順になるので、リストの連結処理を関数 reverse-append で行っています。
リスト : 順列の生成
; flatmap
(define (flatmap f xs)
(apply append (map f xs)))
(define (permutations xs)
(if (null? xs)
'(())
(flatmap (lambda (ys) (interleave (car xs) ys))
(permutations (cdr xs)))))
permutations は簡単です。permutations を再帰呼び出しして (cdr xs) の順列を求め、順列を表す要素 ys に interleave で (car xs) を挿入すればいいわけです。リストを平坦化するため flatmap を使っていることに注意してください。