dev/examples/delicious-graphs.lisp

   1 (in-package #:metatilities)
   2
   3 #|
   4 color by tag weight
   5 |#
   6
   7 (defclass* delicious-post ()
   8   ((post-time nil ia :initarg :time)
   9    (tags nil ia :initarg :tag)
  10    (hash nil ia)
  11    (extended nil ia)
  12    (description nil ia)
  13    (post-href nil ia :initarg :href)))
  14
  15 ;;; ---------------------------------------------------------------------------
  16
  17 (defmethod initialize-instance :after ((object delicious-post) &key)
  18   (setf (tags object) (make-tags-canonical (tags object))))
  19
  20 ;;; ---------------------------------------------------------------------------
  21
  22 (defgeneric make-tags-canonical (tags)
  23   (:documentation "Help convert del.icio.us tags into a canonicl form."))
  24
  25 ;;; ---------------------------------------------------------------------------
  26
  27 (defgeneric make-tag-canonical (tag)
  28   (:documentation "Help convert del.icio.us tags into a canonicl form."))
  29
  30 ;;; ---------------------------------------------------------------------------
  31
  32 (defmethod make-tags-canonical ((tags list))
  33   (mapcar #'make-tag-canonical tags))
  34
  35 ;;; ---------------------------------------------------------------------------
  36
  37 (defmethod make-tags-canonical ((tags string))
  38   (make-tags-canonical (tokenize-string tags :delimiter #\ )))
  39
  40 ;;; ---------------------------------------------------------------------------
  41
  42 (defmethod make-tag-canonical ((tag symbol))
  43   tag)
  44
  45 ;;; ---------------------------------------------------------------------------
  46
  47 (defmethod make-tag-canonical ((tag string))
  48   (form-keyword (string-upcase tag)))
  49
  50 ;;; ---------------------------------------------------------------------------
  51
  52 (defun determine-tag-counts (delicious-post-file)
  53   "Returns a list of tags and their counts from a delicious-post-file."
  54   (bind ((posts (xmls::parse delicious-post-file))
  55          (tags (collect-elements
  56                 ;; the first two elements of posts aren't tags
  57                 (cddr posts)
  58                 :transform
  59                 (lambda (post-info)
  60                   (let ((tags (find "tag" (second post-info)
  61                                     :test #'string-equal
  62                                     :key #'first)))
  63                     (when tags
  64                       (tokenize-string (second tags) :delimiter #\ )))))))
  65     (element-counts
  66      (flatten tags)
  67      :test #'equal
  68      :sort #'>
  69      :sort-on :counts)))
  70
  71 #+Example
  72 ;; this is what a post looks like after it's been transformed by xmls
  73 ("post"
  74  (("time" "2005-11-21T15:25:47Z")
  75   ("tag" "yoga health exercise amherst")
  76   ("hash" "9aad47baf972813c8202b43a56e95a61")
  77   ("description" "Yoga Center Amherst, Massachusetts")
  78   ("href" "http://www.yogacenteramherst.com/")))
  79
  80 (defun parse-delicious-posts (delicious-post-file)
  81   "Transform a delicious post file into a list of post objects."
  82   (collect-elements
  83    (cddr (xmls::parse delicious-post-file))
  84    :transform
  85    (lambda (post-info)
  86      (apply #'make-instance
  87             'delicious-post
  88             (loop for (name value) in (second post-info) nconc
  89                   (list (form-keyword (string-upcase name)) value))))))
  90
  91 ;;; ---------------------------------------------------------------------------
  92
  93 (defun create-bipartite-tag/post-graph (delicious-post-file)
  94   "Creates a bipartite graph of tags, posts and the links between them from
  95 a delicious post file."
  96   (bind ((posts (parse-delicious-posts delicious-post-file))
  97          (g (cl-graph:make-graph 'cl-graph:graph-container)))
  98     (iterate-elements
  99      posts
 100      (lambda (post)
 101        (iterate-elements
 102         (tags post)
 103         (lambda (tag)
 104           (cl-graph:add-edge-between-vertexes g post tag)))))
 105     g))
 106
 107 ;;; ---------------------------------------------------------------------------
 108
 109 #+Example
 110 ;; all tags
 111 (cl-graph:graph->dot
 112  (cl-graph:project-bipartite-graph
 113   (cl-graph:make-graph 'cl-graph:graph-container
 114                        :default-edge-class 'cl-graph:weighted-edge)
 115   (create-bipartite-tag/post-graph #P"user-home:temporary;all-posts.xml")
 116   'keyword
 117   (compose 'type-of 'element))
 118  "user-home:temporary;all-tags.dot"
 119  :vertex-labeler (lambda (vertex stream)
 120                    (format stream "~(~A~)" (symbol-name (element vertex))))
 121  :edge-formatter (lambda (edge stream)
 122                    (format stream "weight=~D" (cl-graph:weight edge))))
 123
 124 ;;; ---------------------------------------------------------------------------
 125
 126 #+Example
 127 (cl-graph:graph->dot
 128  (cl-graph:make-filtered-graph
 129   (cl-graph:project-bipartite-graph
 130    (cl-graph:make-graph 'cl-graph:graph-container
 131                         :default-edge-class 'cl-graph:weighted-edge)
 132    (create-bipartite-tag/post-graph #P"user-home:temporary;all-posts.xml")
 133    'keyword
 134    (compose 'type-of 'element))
 135   (lambda (v)
 136     (search "lisp" (symbol-name (element v)) :test #'string-equal))
 137   :complete-closure-with-links
 138   1)
 139  "user-home:temporary;lisp-tags-20051125.dot"
 140  :vertex-labeler (lambda (vertex stream)
 141                    (format stream "~(~A~)" (symbol-name (element vertex))))
 142  :edge-formatter (lambda (edge stream)
 143                    (format stream "weight=~D" (cl-graph:weight edge))))
 144