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 |

2010-09-06

KMRCLを眺める(200) GENERALIZED-EQUAL-HASH-TABLE

| 22:21 | KMRCLを眺める(200) GENERALIZED-EQUAL-HASH-TABLE - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(200) GENERALIZED-EQUAL-HASH-TABLE - わだばLisperになる

今回は、KMRCLのequal.lispからGENERALIZED-EQUAL-HASH-TABLEです。

KMRCLを眺めつづけてとうとう200回になってしまいました。まだ残りは結構あります…。

今回も引き続きで、名前からしてハッシュテーブルの同値性を判定するものと思われます。

定義は、

(defun generalized-equal-hash-table (obj1 obj2)
  (block test
    (when (not (= (hash-table-count obj1) (hash-table-count obj2)))
      (return-from test nil))
    (maphash
     #'(lambda (k v)
         (multiple-value-bind (value found) (gethash k obj2)
           (unless (and found (generalized-equal v value))
             (return-from test nil))))
     obj1)
    (return-from test t)))

HASH-TABLE-COUNT でサイズを勘定して比較し同じでないなら脱出。サイズが同じなら今度は再帰的にハッシュの要素について GENERALIZED-EQUAL で判定、ということで前回のGENERALIZED-EQUAL-ARRAYと同じ構成です。

(LET ((TAB1 (MAKE-HASH-TABLE))
      (TAB2 (MAKE-HASH-TABLE :TEST 'EQUAL)))
  (KL::GENERALIZED-EQUAL-HASH-TABLE TAB1 TAB2))
;⇒ T
(G000001::AUTO-IMPORT 'ALIST->HASH-TABLE)
;⇒ (:FARE-UTILS)

(LET ((TAB1 (ALIST->HASH-TABLE 
             '((:A . 1)
               (:B . 2)
               (:C . 3))))
      (TAB2 (ALIST->HASH-TABLE 
             '((:A . 1)
               (:B . 2)
               (:c . 3)))))
  (KL::GENERALIZED-EQUAL-HASH-TABLE TAB1 TAB2))
;⇒ T