瀏覽代碼

Added existing code

master
John Whitley 2 月之前
父節點
當前提交
4f511e0941
共有 5 個文件被更改,包括 152 次插入1 次删除
  1. 5
    1
      README.md
  2. 5
    0
      markov.asd
  3. 7
    0
      markov.asd~
  4. 83
    0
      markov.lisp
  5. 52
    0
      markov.lisp~

+ 5
- 1
README.md 查看文件

@@ -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

+ 5
- 0
markov.asd 查看文件

@@ -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")))

+ 7
- 0
markov.asd~ 查看文件

@@ -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"))))

+ 83
- 0
markov.lisp 查看文件

@@ -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))))

+ 52
- 0
markov.lisp~ 查看文件

@@ -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))

Loading…
取消
儲存