Guest User

Untitled

a guest
Jul 23rd, 2019
112
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. (ql:quickload :closer-mop)
  2.  
  3. (defvar *counter* (make-hash-table :test 'equal))
  4. (defvar *obj-counter* (make-hash-table :test 'eq))
  5. (defvar *obj-equal-counter* (make-hash-table :test 'equal))
  6. (defvar *already-counted* (make-hash-table :test 'eql))
  7.  
  8. (defmethod count-nodes :around (object)
  9.   (incf (gethash object *obj-counter* 0))
  10.   (incf (gethash object *obj-equal-counter* 0))
  11.   (unless (gethash object *already-counted*)
  12.     (setf (gethash object *already-counted*) t)
  13.     (ignore-errors (call-next-method))))
  14. (defmethod count-nodes (object))
  15. (defmethod count-nodes ((string string))
  16.   (incf (gethash string *counter* 0) 1))
  17. (defmethod count-nodes ((cons cons))
  18.   (count-nodes (car cons))
  19.   (count-nodes (cdr cons)))
  20. (defmethod count-nodes ((seq sequence))
  21.   (map nil #'count-nodes seq))
  22. (defmethod count-nodes ((object standard-object))
  23.   (let* ((class (class-of object))
  24.          (slots (closer-mop:class-slots class))
  25.          (slot-names (mapcar #'closer-mop:slot-definition-name slots)))
  26.     (dolist (slot-name slot-names)
  27.       (count-nodes slot-name)
  28.       (when (slot-boundp object slot-name)
  29.         (count-nodes (slot-value object slot-name))))))
  30.  
  31. (defun average-count (table)
  32.   (/ (loop for count being the hash-values of table
  33.            sum count)
  34.      (hash-table-count table)))
  35.  
  36. (defun most-common (table)
  37.   (loop with best-values = '()
  38.         with best-count  = 0
  39.         for count being the hash-values of table
  40.         for value being the hash-keys   of table
  41.         when (= count best-count)
  42.           do (push value best-values)
  43.         when (> count best-count)
  44.           do (setf best-values (list value)
  45.                    best-count count)
  46.         finally (return (values best-values best-count))))
  47.  
  48. ;;; Stuff to run
  49.  
  50. (count-nodes (find-class 't))
  51. (format t "Duplication factors:
  52. Strings:       ~4$
  53. EQUAL objects: ~4$
  54. EQ    objects: ~4$"
  55.         (average-count *counter*)
  56.         (average-count *obj-equal-counter*)
  57.         (average-count *obj-counter*))
RAW Paste Data

Adblocker detected! Please consider disabling it...

We've detected AdBlock Plus or some other adblocking software preventing Pastebin.com from fully loading.

We don't have any obnoxious sound, or popup ads, we actively block these annoying types of ads!

Please add Pastebin.com to your ad blocker whitelist or disable your adblocking software.

×