#| 
probmachine.lisp: a generic nondeterministic state machine in Common Lisp
last modified 02.04.2001 lcb

The function state-machine implements a generic nondeterministic state machine.
The machine is specified with an association list. Each element of the list
should be of the form:

   (state-name . ((input-1 . ((probability-1 . (target-state-a . output-a))
                              (probability-2 . (target-state-b . output-b))
                              ...
                              (probability-n . (target-state-n . output-n))))
                  ...
                  (input-n . ((probability-n . (target-state-n . output-n))))))

There can be any number of states, any number of inputs per state, and any 
number of possible target-states per input. Note that probabilities must be 
specified as fractions of one (1/5 or 0.2) and that all probabilities must
sum to one. (This is a wart -- it would be easier to modify the statemachine
on the fly if this requirement did not exist).

(select-next) is an associated function which generates a random value and tests
it against the first (state, input, probability) triple look for the next target
and output. (select-next) calls (try-next-selection) to do the recursive "hard
work" of testing additional triples if the first probability is less than the
random value generated.

(get-current-probability), (get-next-pstate), and (get-next-poutput) are associated
functions which traverse the probability-machine data structure.  Notice that these
are more complicated than their companions for the state-machine (and that I've 
changed the names of the state and output functions so that the deterministic
and nondeterministic machines may be run side by side). In general, this code is
not so elegant -- can you improve it?

probability-machine takes a list of inputs and returns a list of outputs -- which can
then be applied in any way.
|#

(defun probability-machine (input current-state machine-structure)
  (if input
      (let* ((current-input (car input))
	     (remaining-input (cdr input))
	     (next-choice (select-next current-input current-state machine-structure))
	     (target-state (get-next-pstate next-choice current-input current-state machine-structure))
	     (next-output (get-next-poutput next-choice current-input current-state machine-structure)))
	(append (list next-output) 
		(probability-machine remaining-input target-state machine-structure)))))

(defun select-next (input state machine-structure)
  (let* ((random-value (random 1.0))
	 (first-probability (get-current-probability 0 input state machine-structure)))
    (if (> random-value first-probability)
	(try-another-selection random-value first-probability 1 input state machine-structure)
      0)))

(defun try-another-selection (random-value lower-bound index input state machine-structure)
  (let* ((current-probability (+ lower-bound (get-current-probability index input state machine-structure))))
    (if (> random-value current-probability)
	(try-another-selection random-value current-probability (+ index 1) input state machine-structure)
      index)))

(defun get-current-probability (index input state machine-structure)
  (car (nth index (cdr (assoc input (cdr (assoc state machine-structure)))))))

(defun get-next-pstate (index input state machine-structure)
  (car (cdr (nth index (cdr (assoc input (cdr (assoc state machine-structure))))))))

(defun get-next-poutput (index input state machine-structure)
  (cdr (cdr (nth index (cdr (assoc input (cdr (assoc state machine-structure))))))))

#|
simple "does it work?" example:

(setf pmachine-1 '((state-1 . ((0 . ((0.5 . (state-2 . 0))
				    (0.5 . (state-2 . 1))))
			      (1 . ((0.2 . (state-2 . 2))
				    (0.3 . (state-2 . 3))
				    (0.5 . (state-2 . 4))))))
		  (state-2 . ((0 . ((0.5 . (state-2 . 5))
				    (0.5 . (state-2 . 6))))
			      (1 . ((0.5 . (state-1 . 7))
				    (0.5 . (state-1 . 8))))))))

(probability-machine (list 0 0 1 1 0) 'state-1 pmachine-1)

note that multiple calls to probability-machine with the same
input, start-state and machine-structure should produce
different results; if you want the same results every time, stick with
the deterministic state machine....
|#