## markov-chain

### Data

in scheme

#### Tags

graph theory, markov model

### Source Code

``````; markov.scm - Naive balanced Markov Chain implementation for Guile Scheme.
; Markov Chain: https://en.wikipedia.org/wiki/Markov_Chain
; tl;dr:
;   A Markov Chain is a system that undergoes random (possibly weighted)
;   changes in state, with the property that the next state only depends
;   on the current state, and none before it.
;
;   In this implementation, we use a directed graph (a set of nodes, some of
;   which are connected by links which have a direction. e.g. node A could go
;   to node B, but node B doesn't have to go to node A) to represent the chain.

; Graphs are of the form:
;   ...
;
; So a node is identified by its index in the graph.
;
; Links are of the form,
;
; (node-index chance)
;
; where chance is a percentage (0 <= n <= 1).

; Note that it is almost _always_
; easier to just hand-write the graph.
(let ((len (length graph)))
(append graph

; ABSTRACTION
(define (get-node-count graph)
(length graph))

(list node chance))

(list-ref graph node))

; Pick a node out of a list of links.
; The list of links should be sorted from
; least chance to greatest chance.
; XXX: Probably not correct, because
; I'm not sure how to do this properly.
(define (pick-itr prev links len val count)
(cond ((= count (- len 1))
node)

((and (= count 0)
(< val chance))
node)

(else
(if (and (< prev val)
(< val chance))
node
(pick-itr chance
len val
(+ count 1)))))))
(let ((val (random 1.0))
(pick-itr 0 links len val 0)))

; Chain nodes from `graph` together until (end? node chain),
; using pick-link to select each node for chaining.
(define (chain-until node graph pick-link end?)
(define (chain-itr node chain graph)
(if (end? node chain)
(cons node chain)
(cons node chain)
graph)))
(chain-itr node '() graph))

; Build a chain of nodes from the weighted Markov Chain `graph`.
; This implementation assumes that every node has at
; least one link, that all nodes linked to in the graph
; exist, and uses the graph format described above.
(define (markov-chain node graph end?)
(lambda (pair-a pair-b)
(< chance-a chance-b))))))))

; The chain comes out with the last element in front, so reverse it.
(reverse (chain-until node graph pick-link end?))))

; This hacks a string payload onto the end of a node.
(define (markov-chain-with-str node graph end?)
(map (lambda (index)
(get-markov-string (list-ref graph index)))
(markov-chain node
; Strip off the string from each node
; before markov-chain ever sees it.
graph)
end?)))
``````
``````; markov_test.scm - usage examples of markov.scm.
; Uses Guile Scheme.

; Test graph:
; 0 -> 0
; 0 -> 1
; 0 -> 2
; 1 -> 0
; 1 -> 3
; 2 -> 2
; 2 -> 1
; 3 -> 3
; 3 -> 2
(define test-graph
'(((0 .1) (1 .4) (2 .5))  ; 0
((0 .6) (3 .4))         ; 1
((3 .4) (1 .6))         ; 2
((3 .6) (2 .4))))       ; 3

(define (test-end len)
(lambda (node chain)
(if (= (length chain)
len)
#t
#f)))

(define (test-run start length)
(markov-chain start
test-graph
(test-end length)))

; Prisoner-graph:
; 0: There
; 1: Are
; 2: Three
; 3: Four
; 4: Lights

; 0 -> 1
; 1 -> 2
; 1 -> 3
; 2 -> 4
; 3 -> 4

(define prisoner-graph
(list
(list '(1 1) "There")
(list '(2 .5) '(3 .5) "are")
(list '(4 1) "three")
(list '(4 1) "four")
(list '() "lights")))

; Check the odds that "three" or "four" will
; come up from using the prisoner-graph.
(define (odds-prisoner times)
(define (odds-itr three four count)
(if (= count 0)
(cons (/ three times) ; Call exact->inexact if you'd like decimal.
(/ four times))
(if (member "three"
(markov-chain-with-str
0
prisoner-graph
prisoner-end?))
(odds-itr (+ three 1)
four
(- count 1))
(odds-itr three
(+ four 1)
(- count 1)))))
(if (<= times 0)
#f
(odds-itr 0 0 times)))

(define (prisoner-end? node graph)
(= node 4))

(define (test-prisoner)
(string-join (markov-chain-with-str 0
prisoner-graph
prisoner-end?)
" "))
``````