2011/05/21

フラットなリストをネストしたリストに

こういうリストを
(1 2 3 4 :hoge 5 6 7 8 9 10 :end 11 12 13 :foo 14 15 16 :bar 17 18 :baz 19 20 :end :end 21 22 :end 23 24)
こういう風に
(1 2 3 4 (:hoge 5 6 7 8 9 10 :end) 11 12 13 (:foo 14 15 16 (:bar 17 18 (:baz 19 20 :end) :end) 21 22 :end) 23 24)

あまり良い感じのコードも思い浮かばなかったので、素直に(愚直に?)書きました。(gauche)
(define (flat->nest start-pred end-pred ls
                    :optional (filter-func identity))
  (let rec ((ls ls)(acc '()))
    (if (null? ls)
        (values (reverse acc) '())
        (cond ((start-pred (car ls))
               (receive (nested rest)
                   (flat->nest start-pred end-pred (cdr ls) filter-func)
                 (rec rest (cons (filter-func (cons (car ls) nested)) acc))))
              ((end-pred (car ls))
               (values (reverse (cons (car ls) acc))
                       (cdr ls)))
              (else (rec (cdr ls)(cons (car ls) acc)))))))

実行
(define data
  '(1 2 3 4
      :hoge 5 6 7 8 9 10 :end
      11 12 13
      :foo 14 15 16 :bar 17 18 :baz 19 20 :end :end
      21 22 :end 23 24))

(flat->nest (^x (and (keyword? x)
                     (not (eq? :end x))))
            (^x (eq? :end x))
            data)

;; (1 2 3 4
;;    (:hoge 5 6 7 8 9 10 :end)
;;    11 12 13
;;    (:foo 14 15 16 (:bar 17 18 (:baz 19 20 :end) :end)
;;          21 22 :end)
;;    23 24)
いろいろとアレなので、どなたか良い感じにカッチョイイのがあったら教えてください。

追記

コメント欄より。
(define (flat->nest s e ls)
  (let loop ((a (pop! ls)))
    (cond ((null? ls) (cons a '()))
          ((s a)
           (let1 b (cons a (loop (pop! ls)))
             (cons b (loop (pop! ls)))))
          ((e a) (cons a '()))
          (else (cons a (loop (pop! ls)))))))
破壊的な操作も無条件に避けるのではなく、上手に取り入れないといけませんね。

Scheme手習い

5 件のコメント:

  1. ややこしくなっているのは「残りの要素」を引数として受け渡しながら処理しているからだと思うんですよね。 それが無ければ単純になるはず。
    そういう思想から、残りの要素を指す変数を破壊しながら読み出していく方針で書いてみました。 破壊的といっても、内部的な変数を破壊しているだけなので関数の利用者には破壊を観測できません。
    (define (flat->nest s e ls)
    (let loop ((a (pop! ls)))
    (cond ((null? ls) (cons a '()))
    ((s a)
    (let1 b (cons a (loop (pop! ls)))
    (cons b (loop (pop! ls)))))
    ((e a) (cons a '()))
    (else (cons a (loop (pop! ls)))))))

    返信削除
  2. 齋藤さん、いつもコメントありがとうございます!

    たしかに仰る通りですね。
    ついつい無意識に破壊的な操作を避けがちですが、それでかえって複雑になってはいけませんね^^;

    返信削除
  3. ただ、内部的な変数の破壊は、操作の途中で継続が捕捉された場合は観測可能になります。
    具体的にはstart-predの中で継続を保存して、一度全部抜けた後で再開する、などした場合ですが。
    実用上は、ambなどと併用すると予想しない結果が返ってきたりします。
    このへんが継続の厄介なところでありおもしろいところでもあります。

    返信削除
  4. shiroさんコメントありがとうございます。

    破壊的な操作を使う選択肢と同様、継続が捕捉されるケースというのもついつい忘れてしまいます^^;

    返信削除
  5. そうだった。 私もそれで何度も引掛ってるのについ忘れてしまう…。
    Haskell なんかだと、残り要素を状態として引き回すのをモナドで隠蔽できるので、そういった汎用的な枠組みがあるといいなぁとは思います。

    返信削除