blob: 7e72fdd154d04399b0d22e2e273c06023e98b212 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
;;; wasp-markov --- Markov -*- lexical-binding: t; -*-
;;; Commentary:
;;; Code:
(require 'cl-lib)
(require 'rx)
(require 'dash)
(require 's)
(require 'ht)
(require 'wasp-utils)
(cl-defstruct (w/markov (:constructor w/markov-new))
(words (ht-create)) ;; hashtable<word, hashtable<following word, weight>>
)
(defun w/markov-feed (m s)
"Feed string S to M."
(let ((words (cons 'start (s-split (rx whitespace) s))))
(while words
(let ( (cur (car words))
(next (cadr words)))
(unless (ht-get (w/markov-words m) cur)
(ht-set! (w/markov-words m) cur (ht-create)))
(let ((freqs (ht-get (w/markov-words m) cur)))
(ht-set! freqs next (+ 1 (ht-get freqs next 0))))
(setf words (cdr words))))))
(defun w/markov-roll (ws)
"Given weights WS, choose a random word."
(-let
[(total . weighted)
(--reduce-from
(let*
( (word (car it))
(weight (cdr it))
(new (+ (car acc) weight)))
(cons
new
(cons
(cons new word)
(cdr acc))))
(cons 0 nil)
(ht->alist ws))]
(-let [roll (random total)]
(cdr (--first (< roll (car it)) (reverse weighted))))))
(defun w/markov-next (m prev)
"Generate the next word for M given PREV."
(when-let*
( (_ prev)
(ws (ht-get (w/markov-words m) prev)))
(w/markov-roll ws)))
(defun w/markov (m &optional fuel)
"Generate a string from M. Optionally constrain to FUEL words."
(let* ( (prev (w/markov-roll (ht-get (w/markov-words m) 'start)))
(ret prev))
(while-let
( (_ (> fuel 0))
(next (w/markov-next m prev)))
(setf ret (s-append (s-concat " " next) ret))
(setf prev next)
(cl-decf fuel))
ret))
(defun w/markov-log (log)
"Return a Markov chain trained on LOG."
(let ( (ret (w/markov-new))
(loglen (length log))
(counter 0))
(--each log
(cl-incf counter)
(message "processing %s/%s" counter loglen)
(w/markov-feed ret (cdr it)))
ret))
(provide 'wasp-markov)
;;; wasp-markov.el ends here
|
