Work on data, threading and printing of threads master
authorKyle Spaans <kspaans@student.math.uwaterloo.ca>
Tue, 21 Apr 2009 13:19:27 +0000 (09:19 -0400)
committerKyle Spaans <kspaans@student.math.uwaterloo.ca>
Tue, 28 Apr 2009 01:52:21 +0000 (21:52 -0400)
Refactored code in various places. Started to move data collection into a single
data structure that can be processed by multiple functions. Lots of cleanup of
the cleaned up code, so that everything works from nntp-to-dot.ss. For
threading, printing and DOT code generation is now done with some simple helper
functions in thread.ss. Some extra stats are also generated in userstats.ss
using the new data structure.

The data struct lets threads be stored as a tree-like structure in memory, which
is easy to play with. Threading appears to be working, but needs more careful
testing with larger input (read: longer threads) to make sure everything jives
since I no longer trust what SLRN shows me.

nntp-to-dot.ss
thread.ss
userrel.ss
userstats.ss

index b19edfd..27c330a 100644 (file)
@@ -30,6 +30,8 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define dotfile (open-output-file "data/cs136-trial.dot" #:exists 'truncate))
+(fprintf dotfile "digraph cs136__ {\n")
+(fprintf dotfile "// Run starting at: ~a\n" (current-seconds))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define uwnews (connect-to-server "news.uwaterloo.ca"))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; CODE TO EXECUTE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;(posts-per-day first last uwnews)
-(count-users first last uwnews)
-(new-u-vs-time)
+;(thread-print first last uwnews)
+(thread-hash first (+ 100 first) uwnews dotfile)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(fprintf dotfile "// Run finished at: ~a\n}\n" (current-seconds))
 (close-output-port dotfile)
 (disconnect-from-server uwnews)
index 7b81cef..618e292 100644 (file)
--- a/thread.ss
+++ b/thread.ss
@@ -3,14 +3,35 @@
 ;;  any later version.
 
 ;; Detect and work with threads of messages in the newsgroup.
+;; Want to see:
+;; - number of unanswered messages
+;; - number of original posts versus replies
+;; - thread depths, average
+;; -
 
 #lang scheme
 
 (require "common.ss")
+(require srfi/19)
 
 (provide thread-print thread-hash)
 
-(define refers (make-hash))
+(define refers (make-hash)) ;; map Message-IDs to node-IDs
+(define threads '())        ;; list of structures representing each thread
+(define post-count 0)       ;; total number of first-posts
+(define reply-count 0)      ;; total number of reply messages
+
+;; Message Node Struct
+;;  Store newsgroup messages and reporoduce their threaded hierarchy in a
+;;  tree structure.
+;; string     - the user (From: header)
+;; string     - the Message-ID: of the message
+;; date       - date of the message
+;; string     - subject
+;; string     - node ID, used for dot ((make-node-id))
+;; list/mesgn - pointer to parent of this node, empty if no parent.
+;; list       - of mesgn, the children of this node
+(define-struct mesgn (from id date subject node-id parent children) #:mutable #:transparent)
 
 ;-------------------------
 ;-------------------------
 (define (thread-print first last newsd)
   (cond
     [(= first last) (printf "****************\n")]
-    [else (local ((define mesg-from (message-getter newsd first
-                                                   (list from-regexp
-                                                         mid-regexp
-                                                         ref-regexp
-                                                         subj-regexp))))
-            (cond
-             [(and (not (boolean? mesg-from)) (> (length mesg-from) 3))
-               (printf "From: ~a~nSubj: ~a~nMID:  ~a~nRefs: ~a~n~n"
-                      (car mesg-from) (cadr mesg-from) (caddr mesg-from) (get-refs (cadddr mesg-from)))]
-              [(not (boolean? mesg-from))
-              (printf "From: ~a~nSubj: ~a~nMID:  ~a~n~n"
-                      (car mesg-from) (cadr mesg-from) (caddr mesg-from))]))
-          (thread-print (+ first 1) last newsd)]))
+    [else
+     (local
+       [(define mesg-from (message-getter
+                            newsd
+                            first
+                            (list from-regexp mid-regexp ref-regexp subj-regexp)))]
+       (if (boolean? mesg-from)
+           (void)
+           (map (lambda (x) (printf "~a~n" x)) mesg-from))
+       (newline))
+     (thread-print (+ first 1) last newsd)]))
+
+;; thread-post-process: void -> void
+;; do some work with the data collected by thread-hash, print to stdout:
+;; - number of "posts" number of "replies"
+;; - number of unanswered posts
+(define (thread-post-process)
+  ;(for-each (lambda (n) (printf "~a~n" n)) threads)
+  (printf "Posts:   ~a~nReplies: ~a~n" post-count reply-count)
+  (printf "Size: ~a~n" (hash-count refers))
+  (printf "Threads: ~a~n" (length threads))
+  (printf "Heights: ~a~n" (map height threads))
+  (printf "TSizes:  ~a~n" (map num-children threads))
+  (newline)
+  ;(thread-pprint))
+  (thread-dot (cadddr (cddr threads))))
+
+;; thread-refs: (listof string) mesgn -> void
+;; Takes a list of references and a message node and creates the threading
+;; tree appropriately by looking up refs in the hash table. The last ref in
+;; the list should always be the appropriate one to use.
+(define (thread-refs aloref mesgnode)
+   (let [(node-pair (hash-ref refers (last aloref) #f))]
+     (cond
+       [(boolean? node-pair) (printf "$$  Uh oh! Reference does not exist!~n")
+                             (printf "$$  ~a~n" (last aloref))
+                             (printf "$$  ~a~n~n" (mesgn-subject mesgnode))]
+        ;; Add to children of node it refers, and set mesg's parent
+       [else (printf "|--~a (~a) is a reply to ~a (~a)~n~n"
+                     (mesgn-node-id mesgnode)
+                     (mesgn-subject mesgnode)
+                     (mesgn-node-id (cadr node-pair))
+                     (mesgn-subject (cadr node-pair)))
+             (set-mesgn-children! (cadr node-pair)
+                            (cons mesgnode
+                                  (mesgn-children (cadr node-pair))))
+             (set-mesgn-parent! mesgnode (cadr node-pair))])))
+
+;; thread-pprint-internal: int mesgn -> void
+;; Does the work of thread-pprint, takes an argument for the threading
+;; depth.
+(define (thread-pprint-internal depth mesgnode)
+  (cond
+    [(and (empty? (mesgn-children mesgnode)) (= 0 depth))
+     (printf "~a~n" (mesgn-subject mesgnode))]
+    [(empty? (mesgn-children mesgnode))
+     (printf "~a`--> ~a~n"
+             (make-string depth #\space)
+             (substring (mesgn-subject mesgnode) 9))]
+    [(= 0 depth) (printf "~a~n" (mesgn-subject mesgnode))
+                 (for-each
+                   (lambda (node)
+                     (thread-pprint-internal (add1 depth) node))
+                   (mesgn-children mesgnode))]
+    [else (printf "~a`--> ~a~n"
+                  (make-string depth #\space)
+                  (substring (mesgn-subject mesgnode) 9))
+          (for-each
+            (lambda (node)
+              (thread-pprint-internal (add1 depth) node))
+            (mesgn-children mesgnode))]))
+
+;; thread-pprint: void -> void
+;; Traverses the list "thread" and pretty prints threading.
+(define (thread-pprint)
+  (for-each
+    (lambda (node)
+      (thread-pprint-internal 0 node))
+    threads))
+
+;; listmax: (listof nat) -> nat
+;; Finds the max in a list
+(define (listmax lst)
+  (cond
+    [(empty? lst) 0]
+    [else (max (car lst) (listmax (cdr lst)))]))
+
+;; height: mesgn -> int
+;; Calculates the height of the thread
+(define (height n)
+  (cond
+    [(empty? (mesgn-children n)) 1]
+    [else (add1 (listmax (map height (mesgn-children n))))]))
+
+;; num-children: mesgn -> int
+;; Calculates number of messages in thread
+(define (num-children n)
+  (cond
+    [(empty? (mesgn-children n)) 1]
+    [else (foldr + 0 (map num-children (mesgn-children n)))]))
+
+;; thread-dot: mesgn -> void
+;; Takes a Message Node Struct and recursively prints out DOT code representing
+;; that tree. Prints to the given ioport.
+;; Also want easily-changable node-label options:
+;;   node-id, from, subj, date
+(define node-label-format "~a [label=\"~a\\n~a\\n~a\"];")
+(define (thread-dot mesgnode)
+  (local
+    [(define tdot (open-output-file "data/thread.dot" #:exists 'truncate))
+     (define (thread-dot-rec mesgnode)
+       (fprintf tdot
+                node-label-format
+                (mesgn-node-id mesgnode)
+                ;; Remove '"' chars from the header
+                (list->string
+                  (filter (lambda (c) (not (char=? #\" c)))
+                          (string->list (mesgn-from mesgnode))))
+                (mesgn-subject mesgnode)
+                (date->string (mesgn-date mesgnode) "~D"))
+       (for-each (lambda (n)
+                   (fprintf tdot
+                            "~a -> ~a\n"
+                            (mesgn-node-id mesgnode)
+                            (mesgn-node-id n)))
+                 (mesgn-children mesgnode))
+       (for-each thread-dot-rec (mesgn-children mesgnode)))]
+  (fprintf tdot "digraph cs136_threads {\n")
+  (thread-dot-rec mesgnode)
+  (fprintf tdot "// Run finished at: ~a\n}\n" (current-seconds))
+  (close-output-port tdot)))
+
 
+;; thread-hash: int int newsgroup ioport
+;; Reads messages from first to last in newsgroup newsd, printing
+;; info to stdout and to the file dotfile.
+;; Examines threading information, mostly in the "References:" header
+;; of each message, using a hash table "refers" to keep track of things.
+;; HASH TABLE:
+;;  Each message is given a unique node ID which is entered as a value in
+;;  the hash table, with the message-ID as the key. Paired with the node ID
+;;  is the Message Node Structure created for that message. This is so that
+;;  when references are found they can be added to the threading tree.
+;;  References are in the form of message-IDs, so the node ID that a
+;;  message refers to can be looked up.
 (define (thread-hash first last newsd dotfile)
   (cond
-    [(= first last) (printf "@@@@@@@@@@@@@@@@\n")]
-    [else (local [(define mesg-from (message-getter newsd first
-                                                   (list mid-regexp  ; Ugh, the order coming out of this function
-                                                         from-regexp ; depends on what's in the headers, not the
-                                                         ref-regexp  ; order I have here. Usually From, Subj, MID, Refs
-                                                         subj-regexp)))
-                  (define node-id (make-dot-id))]
+    [(= first last) (thread-post-process)]
+    [else
+             ;; Order is: From, Subject, Date, MID, Refs
+     (local [(define message
+               (message-getter
+                  newsd
+                  first
+                  (list mid-regexp from-regexp date-regexp ref-regexp subj-regexp)))
+             (define mesg-from
+               (if (boolean? message) #f (car message)))
+             (define mesg-subj
+               (if (boolean? message) #f (cadr message)))
+             (define mesg-date
+               (if (boolean? message) #f (get-date (caddr message))))
+             (define mesg-mid
+               (if (boolean? message) #f (car (get-refs (cadddr message)))))
+             (define mesg-refs
+               (if (and (not (boolean? message)) (= 5 (length message)))
+                   (get-refs (cadr (cdddr message)))
+                   #f))
+             (define node-id (make-dot-id))]
+       (cond
+          ;; Message exists
+         [(not (boolean? message))
+          (let [(result (hash-ref refers mesg-mid #f))
+                (mesgn-struct
+                  (make-mesgn mesg-from mesg-mid mesg-date mesg-subj node-id '() '()))]
             (cond
-             [(and (not (boolean? mesg-from)) (> (length mesg-from) 2))
-               (let [(result (map (lambda (x) (hash-ref refers x #f))
-                                  (get-refs (caddr mesg-from))))
-                     (mesg-ID (get-refs (caddr mesg-from)))]
-                 (cond
-                   [(boolean? (car result))
-                    (printf "----~nInserting MID(~a) into hash table.~n" (car mesg-ID))
-                      (fprintf dotfile "// Node ~a\n    ~a;\n" mesg-ID node-id)
-                      (hash-set! refers (car mesg-ID) node-id)]
-                   [else (printf "MIDs already in hash table?~n    >>~a<<~n" (caddr mesg-from))]))
-                 ;(if (> (length (car mesg-ID)) 1)
-                 ;    (printf "Exciting, more than one reference!~n")
-                 ;    (void)))
-               (cond [(> (length mesg-from) 3)
-                      (printf "Checking References to find threading...~n")
-                      (let* [(Refs (get-refs (cadddr mesg-from)))
-                             (hRef (hash-ref refers (car Refs) #f))]
-                        (printf "Refs:     ~a~n" Refs)
-                        (printf "          Is it in the table? ~a~n~n" hRef)
-                        (if (boolean? hRef) (void) ; (printf "          Nope.~n~n")
-                            (fprintf dotfile "    ~a -> ~a;\n" hRef node-id)))]
-                     [else ;(printf "Headers:\t ~a~n~n" mesg-from)])]
-                       (for-each (lambda (z) (printf "\t~a~n" z)) mesg-from)
-                       (newline)])]
-              [(not (boolean? mesg-from))
-               (printf "Pooppoop!~n")
-               (printf "From: ~a~nSubj: ~a~nMID:  ~a~n~n"
-                      (car mesg-from) (cadr mesg-from) (caddr mesg-from))]))
-          (thread-hash (+ first 1) last newsd)]))
+               ;; MID collision, should not happen.
+              [(string? result)
+               ;(printf "MIDs already in hash table?~n    >>~a<<~n" (caddr mesg-from))
+               (error `mid-collision)]
+               ;; No MID collision
+              [(boolean? result)
+               (fprintf dotfile "// Node ~a\n    ~a;\n" mesg-mid node-id)
+               (hash-set! refers mesg-mid (list node-id mesgn-struct))
+               (cond
+                  ;; Message has references
+                 [(= 5 (length message))
+                  (set! reply-count (add1 reply-count))
+                  (printf "|-Checking References to find threading...~n")
+                  (thread-refs mesg-refs mesgn-struct)]
+                  ;; Message does not have references
+                 [(= 4 (length message))
+                  (set! post-count (add1 post-count))
+                  (set! threads
+                        (cons mesgn-struct
+                              threads))])]))]
+         [else (printf "&&&&&&&& Whoops! Couldn't read message number ~a~n~n" first)]))
+     (thread-hash (+ first 1) last newsd dotfile)]))
index f3e4e7c..5d7c755 100644 (file)
 ;; Store usernames (email addressses) and their message-ids in a hash table
 ;; for retreival and matching later.
 (define (userrel first last newsd dotfile)
-  (fprintf dotfile "digraph cs136-userrel {\n")
-  (fprintf dotfile "// Run starting at: ~a\n" (current-seconds))
-  (fprintf dotfile "ranksep = 3\n")
-  ;(fprintf dotfile "nodesep = 1.0\n")
+  ;(fprintf dotfile "digraph cs136_userrel {\n")
+  ;(fprintf dotfile "// Run starting at: ~a\n" (current-seconds))
+  ;(fprintf dotfile "ranksep = 3\n")
+  ;;(fprintf dotfile "nodesep = 1.0\n")
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   (cond
     [(= first last) (void)]
@@ -82,5 +82,4 @@
               [else (ins-mid-u mids (car (get-refs (cadr mesg-from)))
                                     (list (car mesg-from) uresult))]))
           (userrel (+ 1 first) last newsd)]
-         [else (userrel (+ 1 first) last newsd)]))])
-  (fprintf dotfile "// Run finished at: ~a\n}\n" (current-seconds)))
+         [else (userrel (+ 1 first) last newsd)]))]))
index 1f2416d..1e2f650 100644 (file)
@@ -14,7 +14,7 @@
 (require "common.ss")
 (require srfi/19)
 
-(provide count-users new-u-vs-time)
+(provide count-users new-u-vs-time posts)
 
 ;; User Statistics Struct
 ;; String - usename in the form of an email address, possibility of duplicates
 ;; Collect stats in the form of '(USERNAME ustats)
 (define users (make-hash))
 
+;; Collect some other, extra stats, store in ngposts struct
+(define pcounts (make-hash))
+;; NewsGroup Posts Struct
+;; string - username ("From:" header)
+;; int    - Total posts by user
+;; int    - "post" posts by user
+;; int    - "reply" posts by user
+(define-struct ngposts (user tp np nr))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;; print-stats: void -> void
@@ -52,9 +61,9 @@
 (define (count-users first last newsd)
   (cond
     [(= first last) (print-stats)]
-    [else (letrec [(message (message-getter newsd first (list from-regexp date-regexp)))
-                   (mesg-from (if (boolean? message) message (car message)))
-                   (mesg-date (if (boolean? message) message (cadr message)))]
+    [else (let* [(message (message-getter newsd first (list from-regexp date-regexp)))
+                 (mesg-from (if (boolean? message) message (car message)))
+                 (mesg-date (if (boolean? message) message (cadr message)))]
             (cond
               [(boolean? message) (void)]
               [else
     (hash-for-each
       users
       (lambda (k v)
-        (letrec [(ndate (date->string (ustats-firstp v) "~D"))
-                 (result (hash-ref new-u-hash ndate #f))]
+        (let* [(ndate (date->string (ustats-firstp v) "~D"))
+               (result (hash-ref new-u-hash ndate #f))]
           (cond
             [(boolean? result) (hash-set! new-u-hash ndate 1)]
             [else (hash-set! new-u-hash ndate (+ 1 result))]))))
     (hash-for-each new-u-hash
                    (lambda (k v) (printf "~a ~a~n" k v)))))
+
+;; posts: int int usergroup
+;; Counts the number of posts of each user, mapping email to post count.
+(define (posts first last newsd)
+  (cond
+    [(= first last)
+     (hash-for-each
+       pcounts
+       (lambda (k v)
+         (printf "~a\t~a~n" k (ngposts-tp v))))]
+    [else
+     (let* [(message (message-getter newsd first (list from-regexp ref-regexp)))
+            (mesg-from (if (boolean? message) #f (car message)))
+            (mesg-refs (if (and (not (boolean? message)) (= 2 (length message)))
+                           #t;(get-refs (cadr message)) ; only need to know, right?
+                           #f))]
+       (cond
+         [(boolean? message) (posts (add1 first) last newsd)]
+         [else
+          (let [(result (hash-ref pcounts mesg-from #f))]
+            (cond
+              [(boolean? result)
+               (if mesg-refs
+                   (hash-set! pcounts mesg-from (make-ngposts mesg-from 1 0 1))
+                   (hash-set! pcounts mesg-from (make-ngposts mesg-from 1 1 0)))
+               (posts (add1 first) last newsd)]
+              [else
+               (if mesg-refs
+                   (hash-set! pcounts mesg-from (make-ngposts
+                                                  mesg-from
+                                                  (add1 (ngposts-tp result))
+                                                  (ngposts-np result)
+                                                  (add1 (ngposts-nr result))))
+                   (hash-set! pcounts mesg-from (make-ngposts
+                                                  mesg-from
+                                                  (add1 (ngposts-tp result))
+                                                  (add1 (ngposts-np result))
+                                                  (ngposts-nr result))))
+               (posts (add1 first) last newsd)]))]))]))