Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2007-09-18

.5

| 00:42 | .5 - わだばLisperになる を含むブックマーク はてなブックマーク - .5 - わだばLisperになる

今回は、SAILのアーカイブサイトにあるコードを読んでみました。

タイムスタンプは、1978-09-20 14:41のファイルなので、約30年前の恐らくMaclispのコードです。

関数名は、pruneです。

CSGREC.LSP [206,LSP]:

http://www.saildart.org/prog/LSP/206_LSP/.html/000088?87,5120

お題:

(defun prune (u)
 (prog (v v1)
    (setq v (cons NIL u))
    (setq v1 v)
   ploop
    (cond ((null (cdr v)) (return (cdr v1))) )
    (cond ((member (cadr v) seen) (rplacd v (cddr v))(go ploop)) )
    (setq v (cdr v))
    (setq seen (cons (car v) seen))
    (go ploop) ))

初見時の感想:

  • なんで、(cons nil u)してるんだろうか?
  • リストの破壊的操作らしい。
  • 重複したアイテムを取り除く関数だと思う。
  • 「condや、関数の終わりの括弧はスペースを一つ入れて分かりやすくする」派
  • NILだけ大文字で書いている意味が分からない
  • なんでリストなのに変数名はuなのか
  • progでseenが宣言されていない

再現:(失敗)

(defun prune (u)
  (prog (v v1 seen)
        (setq v (cons NIL u))
	(setq v1 v)
	ploop
	(cond ((null (cdr v)) (return (cdr v1))) )
	(cond ((member (cadr v) seen) (rplacd v (cddr v)) (go ploop)) )
	(setq seen (cons (cadr v) seen))
	(setq v (cons NIL (cddr v)))	;?????
	(go ploop) ))

途中で、リストの更新をどうやってるのか分からなくなってしまいました。

考察:

自分なりにお題を考察してみました。

  • (con NIL u)している理由
    • rplacdが使いたいからだと思う
  • 構造
    1. seenに既出のアイテムを溜め込んで、
    2. memberで既出かどうかを比較し、
    3. 既出の場合は、rplacdでアイテムをとばして結合してしまう。

以上を踏まえてdoで書き直してみました。

ついでにcopy-listも使ってdelete系からremove系にしてみました。

(defun prune (u &optional (test #'equal))
  (do* ((v (cons () (copy-list u)))
	(v1 v)                  ;ポインタを代入(的な操作)
	(seen () (cons (car v) seen)))
       ((endp (cdr v)) (cdr v1)) ;v1のcdrが指すオブジェクトを返す
    (if (member (cadr v) seen :test test)
	(setf (cdr v) (cddr v))
	(setq v (cdr v)))))