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 |

2011-01-26

C.I.CLを眺める(7) HASHED-REMOVE-DUPLICATES

| 20:23 | C.I.CLを眺める(7) HASHED-REMOVE-DUPLICATES - わだばLisperになる を含むブックマーク はてなブックマーク - C.I.CLを眺める(7) HASHED-REMOVE-DUPLICATES - わだばLisperになる

今回は、C.I.CLのlist.lispから HASHED-REMOVE-DUPLICATES です。

前回のものは、セットを作るものでリストとは違い順番等は無視できましたが、今回は、リストを対象にするもののようです。

定義は、

(DEFUN HASHED-REMOVE-DUPLICATES (SEQUENCE &KEY (TEST (FUNCTION EQL))
                                 TEST-NOT
                                 (START 0) (END (LENGTH SEQUENCE))
                                 (KEY (FUNCTION IDENTITY))
                                 (FROM-END NIL))
  (WHEN TEST-NOT
    (WARN ":TEST-NOT is deprecated.")
    (SETF TEST (COMPLEMENT TEST-NOT)))
  (LET ((TABLE (MAKE-HASH-TABLE :TEST TEST :SIZE (- END START))))
    (MAP NIL (IF FROM-END
                 (LAMBDA (ITEM)
                   (LET ((ITEM-KEY (FUNCALL KEY ITEM)))
                     (MULTIPLE-VALUE-BIND (VAL PRE) (GETHASH ITEM-KEY TABLE)
                       (DECLARE (IGNORE VAL))
                       (UNLESS PRE (SETF (GETHASH ITEM-KEY TABLE) ITEM)))))
                 (LAMBDA (ITEM) (SETF (GETHASH (FUNCALL KEY ITEM) TABLE) ITEM)))
         (IF (OR (/= START 0) (/= END (LENGTH SEQUENCE)))
             (SUBSEQ SEQUENCE START END) SEQUENCE))
    (IF (EQ (TYPE-OF SEQUENCE) 'CONS)
        (LET ((RESULT '()))
          (MAPHASH (LAMBDA (KEY VALUE) (DECLARE (IGNORE KEY)) (PUSH VALUE RESULT))
                   TABLE)
          (IF (OR (/= START 0) (/= END (LENGTH SEQUENCE)))
              (NCONC (SUBSEQ SEQUENCE 0 START) RESULT (SUBSEQ SEQUENCE END))
              RESULT))
        (IF (OR (/= START 0) (/= END (LENGTH SEQUENCE)))
            (LET ((RESULT (MAKE-SEQUENCE (TYPE-OF SEQUENCE)
                                         (+ START (HASH-TABLE-COUNT TABLE)
                                            (- (LENGTH SEQUENCE) END))))
                  (I START))
              (REPLACE RESULT SEQUENCE :END2 START)
              (MAPHASH (LAMBDA (KEY VALUE) (DECLARE (IGNORE KEY))
                               (SETF (AREF RESULT I) VALUE) (INCF I)) TABLE)
              (REPLACE RESULT SEQUENCE :START2 END :START1 I)
              RESULT)
            (LET ((RESULT (MAKE-SEQUENCE (TYPE-OF SEQUENCE)
                                         (HASH-TABLE-COUNT TABLE)))
                  (I 0))
              (MAPHASH (LAMBDA (KEY VALUE) (DECLARE (IGNORE KEY))
                               (SETF (AREF RESULT I) VALUE) (INCF I)) TABLE)
              RESULT)))))

となっています。

随分長いですが、シーケンス全般に対応していること、:test、:key、:start、:end、:from-end等CL標準の関数の作法に準拠して沢山のパラメータを取れるようにしてあるので長くなっているようです。

test-notが使われた時には、"
TEST-NOT is deprecated."と警告が出るという細かさ。

(EQ (TYPE-OF SEQUENCE) 'CONS)は、(CONSP SEQUENCE)でも良さそうですが、飽くまでSEQUENCEである、ということなのでしょうか。

大まかな処理の流れとしては、前回と同様、ハッシュ表で要素を記録することによって重複を排除しています。:from-endの場合は、後ろから見るわけではなくて、既出のものを優先。しかし、CLのMAPHASHは結果は入力の順序を保持しなかったと思うので、この辺りどういうことなのか少し分かりません(KEY次第で変ってくる?)

(hashed-remove-duplicates "41234321" :key (constantly #\x))
;=> "1"

(hashed-remove-duplicates "41234321" :key (constantly #\x) :from-end T)
;=> "4"

そして、:startと:endが取れるので、指定してあった場合は、重複を削除した結果とサンドイッチ。挟む方法としては、リストの場合は、NCONC、ベクター系の場合は、REPLACEを利用しています。

さて、上記の関数ですが、リスト系は問題なく動きますが、ベクター系がSBCLだとエラーになってしまうようです。

原因を追い掛けてみましたが、どうも、TYPE-OFで取れる情報だと、要素の数まで指定された型になってしまうようで、今回の様に結果の長さがオリジナルと違ってしまうと都合が悪いようです。

(type-of "ooo")
;=> (SIMPLE-ARRAY CHARACTER (3))

(make-sequence (type-of "ooo") 1)
;The length requested (1) does not match the type restriction in (SIMPLE-ARRAY CHARACTER (3))

ということで、TYPE-OFの箇所をCLASS-OFにしてみたところ問題ないようです。

HyperSpecによれば、

(subtypep (type-of object) (class-of object)) =>  true, true

が常に成り立つそうなので問題なさそうではあります。

動作は、

(import 'com.informatimago.common-lisp.list::hashed-remove-duplicates)

(hashed-remove-duplicates "1234321")
;=> "1234"

というところ。