リスト処理の小技を書き留める。
ひげぽんさんのところより：
整列済みの number のリストがある。
'(1 3 4 5 6 12 13 15)このようなリストで数が連続している部分は '(1 2 3) -> '(1 . 3) のように両端のみを書くような記法を導入する。
最初の例のリストであれば以下のようになる。
'(1 (3 . 6) (12 . 13) 15)このようなリストの変換をするコードを書きたい。
ひげぽんさんの実装は上記エントリを参照。
Shiro (2008/09/25 03:41:37 PDT): 最初、コメント欄でこういう回答を寄せた。 わりと何も考えずに書き下した感じ。
(define (compact-number-list lis)
(define (scan xs prev head r)
(cond [(null? xs) (reverse (push prev head r))]
[(not prev) (scan (cdr xs) (car xs) (car xs) r)]
[(= (car xs) (+ prev 1)) (scan (cdr xs) (car xs) head r)]
[else (scan (cdr xs) (car xs) (car xs) (push prev head r))]))
(define (push prev head r)
(if (= prev head) `(,head ,@r) `((,head . ,prev) ,@r)))
(scan lis #f #f '()))
そしたら、Scalaで実にエレガントな解法が
case class R(s: Int,e: Int)
case class N(n: Int) extends R(n,n)
def f( input: List[R] ): List[R] = input match {
case R(c1,c2)::N(c3)::cdr if(c2+1==c3) => f(R(c1,c3)::cdr)
case car::cdr => car::f(cdr)
case r => r
}
println(f((1::3::4::5::6::12::13::15::Nil)map(N(_))))
=> List(N(1), R(3,6), R(12,13), N(15))
マッチ節にガードを使ってるとこと、R(s,e)のサブクラスでN(n)が定義できちゃうところが かっこいいのか。前者はutil.matchを使えばできなくはない。
(use util.match)
(define (compact-number-list lis)
(define scan
(match-lambda [((a . b) (c . _) . xs) (=> next)
(if (= (+ b 1) c) (scan `((,a . ,c) ,@xs)) (next))]
[(p . xs) `(,p ,@(scan xs))]
[xs xs]))
(map (match-lambda [(x . y) (if (= x y) x `(,x . ,y))])
(scan (map (lambda (x) (cons x x)) lis))))
ただ、入力数列をペアのリストへ変換し、そして結果をまた変換する分がちょっとまどろっこしい。 (Scalaの回答も最後に結果を戻してないんだけど、heterogeneousなリストは 扱いにくいだろうからScala的にはあれで良いのだろう)
(use util.match)
(define (compact-number-list xxs)
(define (f x y)
(match y (((a . b) . c) (if (= (+ b 1) x) (cons (cons a x) c) (cons x y)))
((a . c) (if (= (+ a 1) x) (cons (cons a x) c) (cons x y)))))
(match xxs (() ()) ((x . xs) (reverse (fold f (list x) xs)))))
1つの要素をもつリストかどうかを調べる。
(define (single? l)
(and (pair? l) (null? (cdr l))))
補記:
(= (length l) 1)
こうして調べるのはとても非効率的だ．第1要素を見終わった直後にはもう必要な情報は分かっているからだ．
整数のリストをもらって、おのおのの要素にその位置を示す数を加えてかえす -- Ansi Common Lisp Ex 3.5
gauche.sequenceを使うと楽ができる。
(use gauche.sequence) (define (pos+ seq) (map-with-index + seq))
これじゃ課題にならないか。素直な実装：
(define (pos+ lis)
(let loop ((r '()) (cnt 0) (lis lis))
(if (null? lis)
(reverse! r)
(loop (cons (+ cnt (car lis)) r) (+ cnt 1) (cdr lis)))))
map-accum というのもある。
(use gauche.collection)
(define (pos+ xs)
(map-accum (lambda (x i)
(values (+ x i) (+ i 1)))
0 xs))
(Scheme:Treeに移動しました。)
(子)リストのリストがあって、子リストにはシンボルが2個以上入ってたとする。 たとえば、((A B) (C D) (E F) (A G) (H F I)) のような感じ。
これを、同じシンボルを含む子リストはまとめたいとする。 たとえば、例で言えば ((A B G) (C D) (E F H I)) のようなリストを返す。
Shiroの解答。あんまり効率は考えてない。(2003/08/21 00:41:40 PDT)
(use srfi-1)
(define (solve sets)
(define (merge1 lst root)
(receive (diff intersection)
(lset-diff+intersection eq? lst root)
(and (not (null? intersection))
(append root diff))))
(define (merge2 lst roots)
(if (null? roots)
(list lst)
(let* ((root (car roots))
(newroot (merge1 lst root)))
(if newroot
(cons newroot (cdr roots))
(cons root (merge2 lst (cdr roots)))))))
(fold merge2 '() sets))
Y.Hana (2003/08/21 09:16:44 PDT) ↓遅そうな気もしますが。
(use srfi-1)
(define (solve xs)
(fold (lambda (x xs)
(receive (p q) (partition (pa$ member x) xs)
(cons (apply lset-union eq? p) q)))
xs (concatenate xs)))
(define (solve x)
(define (f x y)
(let loop ((z (cdr y)) (r '()))
(cond ((null? z) (cons (cons x (car y)) r))
((member x (car z)) (cons (append (car z) (car y))
(append (cdr z) r)))
(else (loop (cdr z) (cons (car z) r))))))
(fold (lambda (x y) (fold f (cons '() y) x)) '() x))
data = (a-value b-value c-value d-value)
みたいに表現されたデータが渡された時、変数a-var, b-var, c-var, d-varに それぞれa-value, b-value, c-value, d-valueの値を入れたい。
(receive (a-var b-var c-var d-var) (apply values data)
処理 ...)
lambdaを気にしないのであれば
(apply (lambda (a-var b-var c-var d-var) 処理 ...) data)
でも良いが、receiveの方が見やすいと思う。他にもbindしたい変数があるときは let-valuesとか使えばいいし。
Biglooにはさらに複雑な構造を分解できるパターンマッチャがついてきたはず。
2002/05/18 02:16:22 PDT
現在は Gauche にも util.match がある。
(use util.match) (match-let ([(a-var b-var c-var d-var) data]) 処理 ...)
(Scheme:Puzzleに移動しました。)
技という程のこともないが、非常に良く使うので書き留めておく。 場所fooに要素のリストが保持されているとする。
追加 (push! foo item) 削除 (update! foo (cut delete item <> eq?))
deleteはsrfi-1、cutはsrfi-26。push!とupdate!はGauche特有のマクロだが、 さほど手間無く書ける。srfi-17(generalized set!) 対応であればfooのところには 一般化された式が書ける。
(push! (cdr *data*) item) (push! (slot-ref object 'item-list) item) 等々...
(2002/10/24 21:56:25 PDT)
リストの各要素への繰り返しはfor-eachやmapで済むけど、 時々ちょっと変わった繰り返しが必要になることがある。
リスト(a b c d)が与えられた時、 (a b c d), (b c d), (c d), (d)のように繰り返す。 CommonLispではmaplと呼ばれてる処理。
(use srfi-1) (pair-for-each proc '(a b c d))
リスト(a b c d)が与えられた時、(a), (a b), (a b c), (a b c d)のように繰り返す。 手続き的に考えたらインデックスiを0からリストの長さまで回して 順次最初のi要素を取るんだろうけど、あんまりらしくない。
(define (reverse-mapl proc lis)
(define (rec rlis)
(if (null? (cdr rlis))
(proc rlis)
(begin (rec (cdr rlis)) (proc (reverse rlis)))))
(unless (null? lis)
(rec (reverse lis))))
こんな感じかな。あるいはsrfi-1のpair-fold-rightを使って
(pair-fold-right (lambda (l knil) (proc (reverse l)))
'()
(reverse lis))
なお、副作用ではなくmapのように結果のリストが欲しい場合は わざわざ実行順序を逆にしなくても、上の第2段階の繰り返しにしといて 結果を逆順にconsしてやれば良い。末尾再帰でやれば自然な順序が 逆順になるから簡単だ。
(pair-fold (lambda (l knil) (cons (proc (reverse l)) knil))
'()
(reverse lis))
結果順ではなく作用順が必要なケースとしては、与えられたパスのディレクトリを 作成する処理などがある。根から順にディレクトリの存在を調べて無かったら 作っていかねばならない。
(2002/12/31 20:06:32 PST)
(define (inits xxs)
(if (null? xxs)
('())
(let ((x (car xxs))
(xs (cdr xxs)))
(cons '() (map (lambda (ls) (cons x ls)) (inits xs))))))
(define (tails xxs)
(if (null? xxs)
('())
(cons xxs (tails (cdr xxs)))))
(2003/01/02 07:46:34 PST)
(Scheme:Treeに移動しました。)
(Scheme:Treeに移動しました。)