;
; markov-chain.scm -- Probabilistic Finite State Machine (Markov Chain).
;
; Based on `fsm-full.scm`, this defines a very simple four-state Markov
; chain, using the same states as the demo FSM's. The difference here is
; that the transitions are specified probabilistically; multiple
; transitions may occur; each transition has a fixed probability.
;
; Another way to look at this is an example of matrix multiplication.
; The state of a Markov chain is a vector, and the state transitions
; can be understood as a matrix (a Markov matrix, where the columns
; sum to one). One iteration of the probabilistic state machine
; corresponds to one matrix multiplication.
;
; In either viewpoint, the numbers, which are probabilities, are
; stored in a FloatValue (holding a single number).
;
; The easiest way to run this is to load this file:
; (add-to-load-path ".")
; (load-from-path "markov-chain.scm")
;
; Then, scroll to the bottom, and some of the commented-out
; examples.
(use-modules (opencog))
;; Define the key used to store probability values
(define prob-key (Predicate "*-ProbabilityKey-*"))
;; Define three objects: a name for the current state vector,
;; a name for the next state vector, and a name for the state
;; transition matrix.
(define my-trans (Concept "My Chain's Transition Rule"))
(define my-state (Anchor "My Chain's Current State"))
(define my-nexts (Anchor "My Chain's Next State"))
;; Helper function to create a state with a given probability
(define (make-state prob state-name)
(define state-link (List my-state state-name))
(cog-set-value! state-link prob-key (FloatValue prob))
state-link
)
;; Define a function to set the initial state of the Markov chain.
;; It starts with 100% probability in this state.
(define (reset-state)
(make-state 1.0 (Concept "initial state"))
(make-state 0.0 (Concept "green"))
(make-state 0.0 (Concept "yellow"))
(make-state 0.0 (Concept "red"))
)
;; Call the function to initialize the state
(reset-state)
;; --------------------------------------------------------------------
;; The set of allowed state transitions. Its a triangular cycle,
;; of green going to yellow going to red going back to green.
;; The initial state transitions into green (and is never visited again).
;;
;; Each rule is labelled with the "my-fsm", so that rules for
;; different FSM's do not clash with one-another. A ContextLink is used
;; because that will allow this example to generalize: Context's are
;; usually used to express conditional probabilities, so that
;;
;; Context <TV>
;; A
;; B
;;
;; represents the probability of B conditioned on A, and the TV holds
;; the numeric value for P(B|A). In this case, A is the current state
;; of the machine, and B the the next state of the machine, so that P(B|A)
;; is the probability of transitioning to state B give that the machine is
;; in state A. Such a system is called a Markov Chain.
;;
; Transition from initial to green with 90% probability.
(cog-set-value!
(ContextLink
(Concept "initial state")
(List my-trans (Concept "green")))
prob-key (FloatValue 0.9))
; Transition from initial state to yellow with 10% probability.
(cog-set-value!
(ContextLink
(Concept "initial state")
(List my-trans (Concept "yellow")))
prob-key (FloatValue 0.1))
; Stay in the initial state with probability zero
(cog-set-value!
(ContextLink
(Concept "initial state")
(List my-trans (Concept "initial state")))
prob-key (FloatValue 0.0))
; Transition from green to yellow with 90% probability
(cog-set-value!
(ContextLink
(Concept "green")
(List my-trans (Concept "yellow")))
prob-key (FloatValue 0.9))
; Transition from green to red with 10% probability
(cog-set-value!
(ContextLink
(Concept "green")
(List my-trans (Concept "red")))
prob-key (FloatValue 0.1))
; Transition from yellow to red with 90% probability
(cog-set-value!
(ContextLink
(Concept "yellow")
(List my-trans (Concept "red")))
prob-key (FloatValue 0.9))
; Transition from yellow to green with 10% probability
(cog-set-value!
(ContextLink
(Concept "yellow")
(List my-trans (Concept "green")))
prob-key (FloatValue 0.1))
; Transition from red to green with 90% probability
(cog-set-value!
(ContextLink
(Concept "red")
(List my-trans (Concept "green")))
prob-key (FloatValue 0.9))
; Stay in the red state with 10% probability
(cog-set-value!
(ContextLink
(Concept "red")
(List my-trans (Concept "red")))
prob-key (FloatValue 0.1))
;; --------------------------------------------------------------------
;;; Create a QueryLink that can take a Markov Chain with the name
;;; `chain-name` and two state vectors: `chain-state` and `chain-next`
;;; Each invocation of the QueryLink will take the current state vector,
;;; multiply it by the transition matrix, and store the result in the
;;; `chain-next` vector.
;;;
(define (create-chain-stepper chain-name chain-next chain-state)
(define curr-state
(List
chain-state
(Variable "$curr-state")
)
)
(define state-trans
(ContextLink
(Variable "$curr-state")
(List
chain-name
(Variable "$next-state")
)
)
)
(define next-state
(List
chain-next
(Variable "$next-state")
)
)
(Query
;; We will need to find the current and the next state
(VariableList
(Variable "$curr-state")
(Variable "$next-state")
)
(And
;; If we are in the current state ...
curr-state
;; ... and there is a transition to another state...
state-trans
)
;; ... then adjust the probability...
(ExecutionOutput
(GroundedSchema "scm: accum-probability")
(List
next-state
state-trans
curr-state
)
)
)
)
;; --------------------------------------------------------------------
;; To move from state to state, we must have some way of accumulating
;; conditional probabilities. This is done by the `accum-probability`
;; function, defined at the end of this section. It accumulates
;; probability using the standard Bayesian interpretation. All
;; the other functions here are helpers, to extract the probability
;; from a truth value, and to set it.
;;; Get the probability on atom. The probability is stored in a FloatValue.
(define (get-prob atom)
(define fv (cog-value atom prob-key))
(if fv
(cog-value-ref fv 0)
0.0))
;;; Return true if the FloatValue on the atom doesn't exist yet.
(define (is-default-tv? atom)
(not (cog-value atom prob-key)))
;;; Set a probability value on the atom.
(define (set-prob atom value)
(cog-set-value! atom prob-key (FloatValue value)))
;;; Accumulate probability (add it to the existing value)
(define (accum-prob atom value)
(if (is-default-tv? atom)
(set-prob atom value)
(set-prob atom (+ (get-prob atom) value))))
;;; Define a function to accumulate the probabilities
;;; It takes as input three atoms: PB, PBA and PA. The truth values on
;;; the last two correspond to P(B|A) (the probability of the state
;;; transition to B, given state A) and P(A) (the probability of being
;;; in state A). The probability of B is then accumulated:
;;; P(B) += P(B|A) * P(A)
(define (accum-probability PB PBA PA)
(accum-prob PB (* (get-prob PBA) (get-prob PA)))
PB
)
;; --------------------------------------------------------------------
;;; Create a QueryLink that will find a state vector, and delete it.
;;; After the next chain state is computed, it must be made into the
;;; current chain state. This is done in a three-step process:
;;; 1) delete the current state vector
;;; 2) copy the next state vector to the current vector
;;; 3) delete the next state-vector.
;;; The below implements steps 1 and 3
(define (create-chain-deleter chain-state)
(Query
(Variable "$state")
;; Find the state vector...
(List chain-state (Variable "$state"))
;; Delete the state vector.
(Delete
(List chain-state (Variable "$state"))
)
)
)
;; --------------------------------------------------------------------
;; Copy a state vector from chain-from to chain-to
;; Since the FloatValues carry the probabilities, they must be copied.
;; Copy FloatValue from second atom to first
(define (copy-tv b a)
(define fv (cog-value a prob-key))
(if fv
(cog-set-value! b prob-key fv))
b)
(define (create-chain-copier chain-to chain-from)
(Query
(Variable "$state")
;; Find the copy-from state vector...
(List
chain-from
(Variable "$state")
)
;; Copy it to the copy-to state vector.
;; We need to use an execution-output link to copy
;; the tv values from one to the other.
(ExecutionOutput
(GroundedSchema "scm:copy-tv")
(List
(List chain-to (Variable "$state"))
(List chain-from (Variable "$state"))
)
)
)
)
;; --------------------------------------------------------------------
;; Move a state vector from chain-from to chain-to
;; This combines the copy and delete operation into one.
;; It should be a bit faster.
(define (create-chain-move chain-to chain-from)
(Query
; Constrain the allowed types on the variable;
; we only want to copy the actual state, and not
; (for example) the subgraphs of this link.
(TypedVariable
(Variable "$state")
(Type "Concept")
)
;; Find the copy-from state vector...
(List
chain-from
(Variable "$state")
)
(List
;; Copy it to the copy-to state vector.
;; We need to use an execution-output link to copy
;; the tv values from one to the other.
(ExecutionOutput
(GroundedSchema "scm:copy-tv")
(List
(List chain-to (Variable "$state"))
(List chain-from (Variable "$state"))
)
)
;; Delete the copy-from state vector
(Delete
(List chain-from (Variable "$state"))
)
)
)
)
;; --------------------------------------------------------------------
;; Create a utility to show the state probabilities
(define (show-state state-vect)
(define (get-tv atom) (get-prob (List state-vect atom)))
(format #t "State vector for \"~A\"\n" (cog-name state-vect))
(format #t "Initial state: ~A\n" (get-tv (Concept "initial state")))
(format #t "Green state: ~A\n" (get-tv (Concept "green")))
(format #t "Yellow state: ~A\n" (get-tv (Concept "yellow")))
(format #t "Red state: ~A\n" (get-tv (Concept "red")))
*unspecified*
)
;; --------------------------------------------------------------------
;;; Create a Markov chain stepper. There are three parts to it.
;;; The first part multiplies the current state by the transition
;;; matrix, putting the result into the next-state vector. The
;;; second part deletes the current-state vector. The third part
;;; moves the next-state vector to the current-state.
(define (take-a-step)
(define my-stepper (create-chain-stepper my-trans my-nexts my-state))
(define my-delter (create-chain-deleter my-state))
(define my-mover (create-chain-move my-state my-nexts))
(cog-execute! my-stepper)
; (show-state my-nexts)
(cog-execute! my-delter)
(cog-execute! my-mover)
(show-state my-state)
)
;;; Show the initial state
; (show-state my-state)
;;; Take one step.
;(take-a-step)
;;; Take three steps.
;;; Try it!
;(take-a-step)
;(take-a-step)
;(take-a-step)
; Reset the state, and run it again
; (reset-state)
; (take-a-step)