Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (ql:quickload :closer-mop)
- (defvar *counter* (make-hash-table :test 'equal))
- (defvar *obj-counter* (make-hash-table :test 'eq))
- (defvar *obj-equal-counter* (make-hash-table :test 'equal))
- (defvar *already-counted* (make-hash-table :test 'eql))
- (defmethod count-nodes :around (object)
- (incf (gethash object *obj-counter* 0))
- (incf (gethash object *obj-equal-counter* 0))
- (unless (gethash object *already-counted*)
- (setf (gethash object *already-counted*) t)
- (ignore-errors (call-next-method))))
- (defmethod count-nodes (object))
- (defmethod count-nodes ((string string))
- (incf (gethash string *counter* 0) 1))
- (defmethod count-nodes ((cons cons))
- (count-nodes (car cons))
- (count-nodes (cdr cons)))
- (defmethod count-nodes ((seq sequence))
- (map nil #'count-nodes seq))
- (defmethod count-nodes ((object standard-object))
- (let* ((class (class-of object))
- (slots (closer-mop:class-slots class))
- (slot-names (mapcar #'closer-mop:slot-definition-name slots)))
- (dolist (slot-name slot-names)
- (count-nodes slot-name)
- (when (slot-boundp object slot-name)
- (count-nodes (slot-value object slot-name))))))
- (defun average-count (table)
- (/ (loop for count being the hash-values of table
- sum count)
- (hash-table-count table)))
- (defun most-common (table)
- (loop with best-values = '()
- with best-count = 0
- for count being the hash-values of table
- for value being the hash-keys of table
- when (= count best-count)
- do (push value best-values)
- when (> count best-count)
- do (setf best-values (list value)
- best-count count)
- finally (return (values best-values best-count))))
- ;;; Stuff to run
- (count-nodes (find-class 't))
- (format t "Duplication factors:
- Strings: ~4$
- EQUAL objects: ~4$
- EQ objects: ~4$"
- (average-count *counter*)
- (average-count *obj-equal-counter*)
- (average-count *obj-counter*))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement