在 Common Lisp 中使用包作为哈希表

dav*_*ugh 1 hashtable sbcl common-lisp package

最初将大量符号存储在一个包中(与项目包分开),并有效地将其用作项目可访问的哈希表(其中键表示简单的集合成员资格数据)是否可行?

* (defpackage :project (:use :cl))
#<PACKAGE "PROJECT">

* (defpackage :temp (:use :cl))
#<PACKAGE "TEMP">

* (in-package :project)
#<PACKAGE "PROJECT">

* (intern "ABC" :temp)
TEMP::ABC
NIL

* (find-symbol "ABC" :temp)
TEMP::ABC
:INTERNAL

;The following is not needed for this project, but is available

* (setf (symbol-value (find-symbol "ABC" :temp)) 123)
123

* (symbol-value (find-symbol "ABC" :temp))
123
Run Code Online (Sandbox Code Playgroud)

这似乎可行,但是有充分的理由避免并仅使用哈希表来代替吗?我的第一个想法是避免使用大量杂项键符号使项目包变得混乱。这些符号将在运行时从字符串生成(以检查哈希表中的集合成员资格)。这似乎涉及许多符号的运行时驻留,这些符号可能存储在表中,也可能不存储在表中。但我也想知道是否find-symbol可以比gethash. 或者,我可以只使用equal字符串的哈希表,但查找的绝对数量似乎指向eq而不是equal。寻找任何明智的建议,谢谢。

编辑:将equal哈希表与包符号查找进行比较的简单测试。

一、哈希表测试

* (defun random-string (n)
  "Generate a random string of length n."
  (let ((charset "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
    (iter (repeat n)
          (collect (char charset (random (length charset)))
                   result-type string))))
RANDOM-STRING

* (defparameter *ht* (make-hash-table :test #'equal :size 10000))
*HT*

* (iter (for i from 0 to 5000)
      (setf (gethash (random-string 5) *ht*)
            t))
NIL

* (time (dotimes (i 1000000)
        (gethash (random-string 5) *ht*)))

Evaluation took:
  0.150 seconds of real time
  0.109375 seconds of total run time (0.109375 user, 0.000000 system)
  72.67% CPU
  541,959,942 processor cycles
  127,937,760 bytes consed
Run Code Online (Sandbox Code Playgroud)

下一个包查找

* (defpackage :temp1)
#<PACKAGE "TEMP1">

* (iter (for i from 0 to 5000)
      (intern (random-string 5) :temp1))
NIL

* (time (dotimes (i 1000000)
        (find-symbol (random-string 5) :temp1)))

Evaluation took:
  0.224 seconds of real time
  0.171875 seconds of total run time (0.156250 user, 0.015625 system)
  [ Run times consist of 0.015 seconds GC time, and 0.157 seconds non-GC time. ]
  76.79% CPU
  807,944,162 processor cycles
  127,954,624 bytes consed
Run Code Online (Sandbox Code Playgroud)

哈希表大约快 1.5 倍

ign*_*ens 5

你可以这样做,但它在风格上很糟糕,而且几乎肯定很慢。

特别请理解,如果您有一个在运行时创建的字符串,并且希望将其映射到唯一的对象,以便所有包含相同字符序列的字符串映射到同一对象,则必须考虑每个元素字符串的:换句话说,您必须执行equal字符串的操作。没有什么秘密魔术可以让你eq在字符串上使用。

因此,要做你想做的事情,即非正式的“实习”字符串,你可以比较你正在考虑的选项:

哈希表是一流的对象,并且只做您想要做的事情,这就是它们的设计目的。

并不完全是一流的:您必须全局管理您使用的包。包几乎肯定在内部使用哈希表或某种等效结构。包将字符串映射到符号,这些符号是预定义的对象,可能相当重量级。软件包的设计初衷并不是为了实现您想要的功能,尽管可能会被滥用。

实际上,这意味着包几乎肯定会慢得多,分配更多内存,并且您的代码将变得丑陋不堪。

我做了一些简短的测试,比较了在新包中创建大量符号(即实习大量唯一字符串)与将这些相同的字符串添加到equal哈希表中。这在 LispWorks 中慢了大约 10 倍,在 SBCL 中慢了大约 6 倍。


一个可能的反例是您有这样的场景:

  • 我有大量包含字符串之类的对象集合。
  • 对于给定的字符串,我现在希望尽快针对如此大量的对象对其进行检查。

所以我现在想做的就是在这些集合中存储以某种独特方式表示字符串的对象,这将节省大量的字符串比较。

传统的方法是通过包或(今天可能更好)通过哈希表使用符号:

(defvar *string-table*
  ;; Note we're gong to case-fold here.
  (make-hash-table :test #'equalp))

(defun canonicalize-string (s &key (table *string-table*) (upper-case t))
  (or (gethash s table)
      (setf (gethash s table) (make-symbol (if upper-case (string-upcase s) s)))))
Run Code Online (Sandbox Code Playgroud)

现在,每当您需要字符串的符号时,您都需要调用canonicalize-string(类似于find-symbol/ ),然后您可以编写,例如:intern

(let ((s (canonicalize-string ...)))
  (dolist (set my-large-collection-of-sets nil)
    (when (present-in-set-p s set)
      (return set))))
Run Code Online (Sandbox Code Playgroud)

除了,等等。如果您仅使用符号作为字符串的唯一化身,为什么要使用符号?

(defun canonicalize-string (s &key (table *string-table*) (upper-case t))
  (or (gethash s table)
      (setf (gethash s table) (if upper-case (string-upcase s) s))))
Run Code Online (Sandbox Code Playgroud)

现在,这段代码将分配更少的资源,但仍然执行与原始代码完全相同的操作。


最后一点,定义轻量级内部字符串非常容易,并为其提供文字语法:

(in-package :cl-user)

(defvar *interned-strings-table* nil)

(defstruct interned-strings-table
  (parent *interned-strings-table*)
  (table (make-hash-table :test #'equal)))

(setf *interned-strings-table*
  (make-interned-strings-table :parent nil))

(defun intern-string (s &optional (table *interned-strings-table*))
  (do ((current table (interned-strings-table-parent current)))
      ((not current)
       (setf (gethash s (interned-strings-table-table table)) s))
    (let ((it (gethash s (interned-strings-table-table current))))
      (when it (return it)))))

(defun clear-interned-strings (&optional (table *interned-strings-table*))
  (do ((current table (interned-strings-table-parent current)))
      ((not current) t)
    (clrhash (interned-strings-table-table current))))

(defun read-interned-string (reader stream char)
  (let ((s (funcall reader stream char)))
    (typecase s
      (string
       (intern-string s))
      (t
       (error "oops")))))

(defun make-string-interning-readtable (&optional (from *readtable*) (to nil))
  (let ((strt (copy-readtable from to)))
    (when (get-dispatch-macro-character #\# #\" strt)
      (error "Someone is already using #\""))
    (set-dispatch-macro-character
     #\# #\"
     (let ((string-reader (get-macro-character #\" strt)))
       (lambda (stream char prefix)
         (declare (ignore prefix))
         (read-interned-string string-reader stream char)))
     strt)
    strt))
Run Code Online (Sandbox Code Playgroud)

现在*readtable*设置为以下结果(make-string-interning-readtable)

> (eq #"foo" #"foo")
t

> (eq #"foo" (intern-string "foo"))
t

> (eq #"foo" "foo")
nil                                     ;in fact maybe

> (eq "foo" "foo")
nil                                     ;in fact maybe
Run Code Online (Sandbox Code Playgroud)