Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (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))
Add Comment
Please, Sign In to add comment