newsgroups.lisp -- See the blog entry at tinyurl.com/ybct3cm. Runs on CCL.

newsgroups.lisp

(defpackage :newsgroups
  (:use :common-lisp :cl-ppcre :pcall))

(in-package :newsgroups)

(defun distribution (items)
  (loop with result = (make-hash-table :test #'equal)
        for item in items
        do (setf (gethash item result) (1+ (gethash item result 0)))
        finally (return result)))

(defun distribution/directory (directory)
  (flet ((distribution/file (path)
           (distribution (split "\\W+" (nstring-downcase (slurp path))))))
    (apply #'merge-with #'+ (pmapcar #'distribution/file (directory directory)))))

(defun output-distribution/directory (input-directory output-directory)
  (let ((result (loop for key being the hash-key using (hash-value value)
                      of (distribution/directory input-directory)
                      collect (list key value))))
    (flet ((save-ordered-by (filename function key)
             (spit (make-pathname :name filename :defaults output-directory)
                   (format nil "~{~{~a~16t~a~}~%~}"
                           (sort (copy-list result) function :key key)))))
      (save-ordered-by "descending" #'> #'second)
      (save-ordered-by "alphabetical" #'string< #'first))))

(defun pmapcar (function list)
  (let ((result (mapcar (lambda (e) (pexec (funcall function e))) list)))
    (map-into result #'join result)))

(defun merge-with (merge-function &rest hash-tables)
  (loop with result = (make-hash-table :test #'equal)
        for hash in hash-tables
        do (merge-into result hash :merge-function merge-function)
        finally (return result)))

(defun merge-into (into from &key (merge-function #'values))
  (flet ((merge-entry (merge-function key value hash)
           (multiple-value-bind (into-value value-exists) (gethash key hash)
             (if value-exists
                 (setf (gethash key hash)
                       (funcall merge-function into-value value))
                 (setf (gethash key hash) value)))))
    (loop for key being the hash-keys using (hash-value value) of from
          do (merge-entry merge-function key value into)
          finally (return into))))

(defun slurp (path)
  (with-open-file (stream path)
    (let ((string (make-string (file-length stream))))
      (values string (read-sequence string stream)))))

(defun spit (path string &optional (if-exists :supersede))
  (with-open-file (stream path :direction :output
                               :if-does-not-exist :create
                               :if-exists if-exists)
    (write-string string stream) nil))