Scheme:リスト処理

Scheme:リスト処理

リスト処理の小技を書き留める。

数値リストのコンパクトな表現　

ひげぽんさんのところより：

整列済みの 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的にはあれで良いのだろう)

single?

1つの要素をもつリストかどうかを調べる。 

(define (single? l)
        (and (pair? l) (null? (cdr l))))

補記: 

(= (length l) 1)

こうして調べるのはとても非効率的だ．第1要素を見終わった直後にはもう必要な情報は分かっているからだ．

pos+

整数のリストをもらって、おのおのの要素にその位置を示す数を加えてかえす -- 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に移動しました。)

集合の統合

sasadaさんとこ、および 酒井さんとこから。

(子)リストのリストがあって、子リストにはシンボルが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])
  処理 ...)

Quasiquote Magic

(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で済むけど、 時々ちょっと変わった繰り返しが必要になることがある。

mapl

リスト(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))

逆mapl

リスト(a b c d)が与えられた時、(a), (a b), (a b c), (a b c d)のように繰り返す。 手続き的に考えたらインデックスiを0からリストの長さまで回して 順次最初のi要素を取るんだろうけど、あんまりらしくない。

  1. 入力リストを逆にしてmaplを適用すれば、(d c b a), (c b a), (b a), (a)と 繰り返すことが出来る。
  2. さらに、procに渡す直前にもいちどreverseをかけてやれば、 (a b c d), (a b c), (a b), (a)という繰り返しができる。
  3. この繰り返しの順序を逆転させるには…一番シンプルなのは再帰にすることだ。 
(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)

与えられた木から、子→親への対応を作る

(Scheme:Treeに移動しました。)

木の統合 (親 子 孫 ひ孫 …)

(Scheme:Treeに移動しました。)

Topics
Sponsored Links
Search
Recent Changes
More ...
Last modified : 2013/04/26 05:30:50 UTC
WiLiKi 0.8.3 running on Gauche 0.9.15