@@ -1,3 +1,7 @@ | |||
# markov | |||
Dusty old markov chain program I wrote in Common LISP a long while ago. Dug it up recently in honor of Joe Biden. | |||
Dusty old markov chain program I wrote in Common LISP a long while ago. Dug it up recently in honor of Joe Biden. | |||
I gave it a license but really, who cares lmao | |||
This may or may not exist in another repo somewhere, this is ancient, I don't remember |
@@ -0,0 +1,5 @@ | |||
(defsystem "markov" | |||
:description "Markov is a simple library for Markov Chains." | |||
:version "0.0.1" | |||
:depends-on ("alexandria" "cl-utilities") | |||
:components ((:file "markov"))) |
@@ -0,0 +1,7 @@ | |||
(defsystem "markov" | |||
:description "Markov is a simple library for Markov Chains." | |||
:version "0.0.1" | |||
:depends-on ("alexandria" "cl-utilities") | |||
:components ((:file "packages") | |||
(:file "macros" :depends-on ("packages")) | |||
(:file "hello" :depends-on ("macros")))) |
@@ -0,0 +1,83 @@ | |||
(defpackage :markov | |||
(:use | |||
; :alexandria :cl-utilities | |||
:common-lisp) | |||
(:export :concat-spaces | |||
:pick-node | |||
:build-chain | |||
:build-random-chain | |||
:genchain)) | |||
(defun read-file-into-list (filename) | |||
(with-open-file (stream filename) | |||
(loop for line = (read-line stream nil) | |||
while line | |||
collect line))) | |||
(defun concat-spaces (strs) | |||
(remove #\Space (apply #'concatenate 'string | |||
(mapcar #'(lambda (x) (concatenate 'string x " ")) strs)) | |||
:count 1 :from-end t)) | |||
(defun copy-table (table) | |||
(let ((new-table (make-hash-table | |||
:test (hash-table-test table) | |||
:size (hash-table-size table)))) | |||
(maphash #'(lambda(key value) | |||
(setf (gethash key new-table) value)) | |||
table) | |||
new-table)) | |||
(defun pick-node (node) | |||
(if (second node) | |||
(nth (random (length (second node))) (second node)) | |||
nil)) | |||
(defun build-chain (inode terminator termstr &optional inlist) | |||
(let ((startnode (if (symbolp inode) (eval inode) inode))) | |||
(cond | |||
((equal termstr (first startnode)) inlist) | |||
((not (second startnode)) (append inlist (list (first startnode)))) | |||
((zerop (1- terminator)) (append inlist (list (first startnode)))) | |||
(t (build-chain (pick-node startnode) | |||
(1- terminator) | |||
termstr | |||
(append inlist (list (first startnode)))))))) | |||
(defun build-random-chain (table terminator termstr) | |||
(build-chain | |||
(gethash (nth (random (length | |||
(alexandria:hash-table-keys table))) | |||
(alexandria:hash-table-keys table)) | |||
table) | |||
terminator termstr)) | |||
(defun process-str (strtable instr) | |||
(let ((tab (copy-table strtable))) | |||
(dolist (x (cl-utilities:split-sequence #\Space instr)) | |||
(when (not (gethash x tab)) | |||
(setf (gethash x tab) (list x nil)))) | |||
(let ((y nil)) | |||
(dolist (x (cl-utilities:split-sequence #\Space instr)) | |||
(when (and x y) | |||
(push (gethash x tab) (second (gethash y tab)))) | |||
(setf y x)) | |||
(push '("!TERM" nil) (second (gethash y tab)))) | |||
tab)) | |||
(defun process-list (strtable inlist) | |||
(if inlist (process-list (process-str strtable (first inlist)) | |||
(rest inlist)) | |||
strtable)) | |||
(defun bootstrap-table (filename) | |||
(let* ((flist (read-file-into-list filename)) | |||
(mash (make-hash-table :test #'equal)) | |||
(endtbl (process-list mash flist))) | |||
endtbl)) | |||
(defun outchain (table terminator termstr) | |||
(let ((str "") | |||
(lst (build-random-chain table terminator termstr))) | |||
(dolist (x lst) | |||
(setf str (concatenate 'string str " " x))) | |||
str)) | |||
(defun genchain (filename terminator &optional termstr times) | |||
(let ((table (bootstrap-table filename)) | |||
(tstr (if termstr termstr "!TERM"))) | |||
(if times | |||
(let ((outbl nil)) | |||
(progn (dotimes (i times) | |||
(push (outchain table terminator tstr) outbl)) | |||
outbl)) | |||
(outchain table terminator tstr)))) |
@@ -0,0 +1,52 @@ | |||
(require 'cl-utilities) | |||
(require 'alexandria) | |||
(defun read-file-into-list (filename) | |||
(with-open-file (stream filename) | |||
(loop for line = (read-line stream nil) | |||
while line | |||
collect line))) | |||
(defun concat-spaces (strs) | |||
(remove #\Space (apply #'concatenate 'string | |||
(mapcar #'(lambda (x) (concatenate 'string x " ")) strs)) | |||
:count 1 :from-end t)) | |||
(defun copy-table (table) | |||
(let ((new-table (make-hash-table | |||
:test (hash-table-test table) | |||
:size (hash-table-size table)))) | |||
(maphash #'(lambda(key value) | |||
(setf (gethash key new-table) value)) | |||
table) | |||
new-table)) | |||
(defun pick-node (node) | |||
(if (second node) | |||
(nth (random (length (second node))) (second node)) | |||
nil)) | |||
(defun build-chain (inode terminator termstr &optional inlist) | |||
(let ((startnode (if (symbolp inode) (eval inode) inode))) | |||
(cond | |||
((equal termstr (first startnode)) inlist) | |||
((not (second startnode)) (append inlist (list (first startnode)))) | |||
((zerop (1- terminator)) (append inlist (list (first startnode)))) | |||
(t (build-chain (pick-node startnode) | |||
(1- terminator) | |||
termstr | |||
(append inlist (list (first startnode)))))))) | |||
(defun build-random-chain (table terminator termstr) | |||
(build-chain | |||
(gethash (nth (random (length | |||
(alexandria:hash-table-keys table))) | |||
(alexandria:hash-table-keys table)) | |||
table) | |||
terminator termstr)) | |||
(defun process-str (strtable instr) | |||
(let ((tab (copy-table strtable))) | |||
(dolist (x (cl-utilities:split-sequence #\Space instr)) | |||
(when (not (gethash x tab)) | |||
(setf (gethash x tab) (list x nil)))) | |||
(let ((y nil)) | |||
(dolist (x (cl-utilities:split-sequence #\Space instr)) | |||
(when (and x y) | |||
(push (gethash x tab) (second (gethash y tab)))) | |||
(setf y x)) | |||
(push '("!TERM" nil) (second (gethash y tab)))) | |||
tab)) |