Dusty old markov chain program I wrote in Common LISP a long while ago. Dug it up recently in honor of Joe Biden.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

markov.lisp~ 1.8KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152
  1. (require 'cl-utilities)
  2. (require 'alexandria)
  3. (defun read-file-into-list (filename)
  4. (with-open-file (stream filename)
  5. (loop for line = (read-line stream nil)
  6. while line
  7. collect line)))
  8. (defun concat-spaces (strs)
  9. (remove #\Space (apply #'concatenate 'string
  10. (mapcar #'(lambda (x) (concatenate 'string x " ")) strs))
  11. :count 1 :from-end t))
  12. (defun copy-table (table)
  13. (let ((new-table (make-hash-table
  14. :test (hash-table-test table)
  15. :size (hash-table-size table))))
  16. (maphash #'(lambda(key value)
  17. (setf (gethash key new-table) value))
  18. table)
  19. new-table))
  20. (defun pick-node (node)
  21. (if (second node)
  22. (nth (random (length (second node))) (second node))
  23. nil))
  24. (defun build-chain (inode terminator termstr &optional inlist)
  25. (let ((startnode (if (symbolp inode) (eval inode) inode)))
  26. (cond
  27. ((equal termstr (first startnode)) inlist)
  28. ((not (second startnode)) (append inlist (list (first startnode))))
  29. ((zerop (1- terminator)) (append inlist (list (first startnode))))
  30. (t (build-chain (pick-node startnode)
  31. (1- terminator)
  32. termstr
  33. (append inlist (list (first startnode))))))))
  34. (defun build-random-chain (table terminator termstr)
  35. (build-chain
  36. (gethash (nth (random (length
  37. (alexandria:hash-table-keys table)))
  38. (alexandria:hash-table-keys table))
  39. table)
  40. terminator termstr))
  41. (defun process-str (strtable instr)
  42. (let ((tab (copy-table strtable)))
  43. (dolist (x (cl-utilities:split-sequence #\Space instr))
  44. (when (not (gethash x tab))
  45. (setf (gethash x tab) (list x nil))))
  46. (let ((y nil))
  47. (dolist (x (cl-utilities:split-sequence #\Space instr))
  48. (when (and x y)
  49. (push (gethash x tab) (second (gethash y tab))))
  50. (setf y x))
  51. (push '("!TERM" nil) (second (gethash y tab))))
  52. tab))