shift-register.lsp Version 1.00 11 March 2005 Author Steven Jones Contact jones57@swbell.net include the word "nyquist" in subject line The contents of this file are released under the terms of the GNU General Public License. See the file LICENSE.txt Defines a class for simulating shift-registers. A shift register consist of a series of nodes (cells/stages?) linked in a linear configuration. [ ]-->[ ]-->[ ]--> ... -->[ ] When shifted the contents of each cell replaces the previous contents of the cell to its right. Practical applications include the conversion between parallel and serial data streams and the production of pseudo-random numbers. Adding feedback taps at various stages greatly increases the register's complexity. Its possible for registers to produce complex numeric sequences ranging from highly predictable to pseudo-random. Typically the sum of the feedback stages, usually to some modulo, is placed into the initial cell on each shift operation. In this implementation the user provides a feedback function and the register cells may contain any data type with the provision that the feedback function expects that type. Usually the cells contents are numeric. See below for several usage examples.
class
Simulation of a shift register.
Instance variables are:
.register - A list which represents the registers current state.
.taps - A list Boolean flags of the same length as .register.
A true flag indicates that a specific cell contributes to
the feedback when the register is shifted.
.fbfn - The feedback function proper, default is simple addition
.advance-hook - A function which is applied to the register contents after they are shifted.
The hook does not effect the register proper but provides additional
processing of the registers output.
method
(send shift-register :new seed)
Construct new shift register
seed - List. The seed list determines both the registers length as well
as its initial state.
return - Object. A new instance of shift-register
method
(send /shift-register/ :tap n flag) Add (remove) feedback tap. n - Integer. The stage to be effected. 0 <= n < (length seed) flag - Boolean. True if stage n is to be tapped. return - Nil.
method
(send /shift-register/ :length) return - integer. The number of stages in the register
method
(send /shift-register/ :answer :get-state) return - List. The current state of the register
method
(send /shift-register/ :answer :set-state seed)
Initialize (seed) the registers state.
seed - list. A list containing the registers new state. The length of
seed must equal the original length of the register.
method
(send /shift-register/ :get-node [n])
Get the contents of specific register node.
n - Integer. The nodes index. 0 <= n < length
Defaults to the final node.
return - Any. The contents of node n.
method
(send /shift-register/ :set-node n val) Set value of specific register node. n - Integer. The nodes index val - Any.
method
(send /shift-register/ :fbfn fn)
Set the feedback function.
fn - Closure. The feedback function must have the form
(lambda (&rest args) ...)
The default function is
(lambda (&rest args)(apply #'+ args))
Another useful function is
(lambda (&rest args)(rem (truncate (apply #'+ args)) c))
where c is a positive integer.
return - Nil.
method
(send /shift-register/ :advance-hook fn) Set the output processing hook. The advance method is used to shift the register one complete cycle and then returns a list containing the registers current state. advance-hook is used to process this list prior to returning it. The default hook is the identity. (lambda (&rest args) args)
method
(send /shift-register/ :aggregate-taps [inject]) Build a list from the tapped cells. The inject value may be used to place a new value into the register during the feedback process. inject - Any. Default 0 return - List.
method
(send /shift-register/ :determine-feedback-object [inject]) Aggregate the tapped nodes into a list along with the inserted value, then apply the feedback function. inject - Any. Default 0 return - Any.
method
(send /shift-register/ :step [inject]) Advance register contents by one stage. Prior to advancing the register the tapped stage values are aggregated along with the injected value, and the fbfn applied. The result is inserted into the initial node after the shifting operation is completed. inject - Any. Default 0 return - Nil
method
(send /shift-register/ :advance [n [inject]])
Cycle the entire registers contents n times.
n - Integer. The number of times to cycle the register, default 1
inject - Any. The feedback injection value, default 0.
return - Any. After the register has been cycled n times the register
contents, i the form of a list, are processed by the
advance-hook function. The result of the hook serves as the return
value. By default the result is a list containing th register
current state.
method
(send /shift-register/ :rep [echo]) Return or display a string representation of the registers current state.
example
;; @doc example shift-register
;; In the first example we seed the register with a simple c 7th arpeggio and
;; only tab the final node for feedback. We also inject the value 1 into the
;; register on each shift operation. The feedback function takes the sum of
;; the final stage and the injected value, effectively transposing by 1/2
;; step. However the fb function uses the rem function to return only
;; remainder of the addition after dividing by 12. Using the rem function is
;; often useful to keep the register values in bounds. Being a deterministic
;; structure the outcome has a period after which it repeats. In this case the
;; default argument values produce a period of 60 events.
;;
(defun sr-test-1 (&key (reps 60)(seed (list c5 bf4 g4 e4 c4))(speed 0.12)(inject 1))
(let (sr val)
(setf sr (send shift-register :new seed))
(send sr :tap (1- (length seed)) 't)
(send sr :fbfn #'(lambda (&rest args)
(+ c4 (rem (truncate (apply #'+ args)) 12))))
(simrep (rep reps)
(progn
(setf val (send sr :get-node))
(send sr :step inject)
(format t "~%at ~a X ~a step ~a" rep speed val)
(at (* rep speed)(cue (pluck val speed)))))))
;; Example 2 is like example 1 except we include taps from stages 1 and 2 and
;; by default inject 0 on each shift. The fb function has been modified to
;; provide a greater range of output values. The result is a bit more
;; meandering but still maintenance some order.
;;
;; Notice we shift the register 120 times before using it. At times you may
;; want to "pre-run" the register so that it settles down into a regular
;; pattern. This may or may not be one of those times.
;;
(defun sr-test-2 (&key (reps 60)(seed (list c5 bf4 g4 e4 c4))(speed 0.12)(inject 0))
(let (sr val)
(setf sr (send shift-register :new seed))
(send sr :tap (1- (length seed)) 't)
(send sr :tap 1 't)
(send sr :tap 2 't)
(send sr :fbfn #'(lambda (&rest args)
(+ c4 (rem (truncate (apply #'+ args)) 18))))
(dotimes (dummy 120)
(send sr :step inject))
(simrep (rep reps)
(progn
(setf val (send sr :get-node))
(send sr :step inject)
(format t "~%at ~a X ~a step ~a" rep speed val)
(at (* rep speed)(cue (pluck val speed)))))))
;; For example 3 only the final stage is tapped and by default the injected
;; value is 0. The fb function returns a slightly randomized version of its
;; arguments. The result is a regular pattern with slight random transposition
;; on each iteration.
;;
(defun sr-test-3 (&key (reps 60)(seed (list c5 bf4 g4 e4 c4))(speed 0.12)(variance 0.005)(inject 0))
(let (sr val)
(nice-load "math")
(setf sr (send shift-register :new seed))
(send sr :tap (1- (length seed)) 't)
(send sr :fbfn #'(lambda (&rest args)
(let* ((step (apply #'+ args))
(delta (* step variance)))
(+ step (* (rnd) delta)))))
(simrep (rep reps)
(progn
(setf val (send sr :get-node))
(send sr :step inject)
(at (* rep speed)(cue (pluck val speed)))
))))
;; In example 4 we use a register without feedback as a delay line. The source
;; material are a few notes from Bach. In one channel the melody is played
;; directly from the source list. The other channel is transposed up an octave
;; and delayed by the length of the register. One advantage this type of delay
;; over an audio delay is that the delayed sound need not be the same as the
;; non-delayed sound. Of course the register may also be tapped at
;; intermediate stages to provide additional output.
;;
(defun sr-test-4 (&key (delay 6)(speed 0.12))
(let (sr source)
(setf source (list a4 g4 fs4 a4 g4 a4 d4
b4 a4 fs4 b4 a4 b4 e4
c5 c5 b4 g4 e4 fs4 g4
fs4 e4 fs4 g4 g4 e4 cs4 d4))
(setf sr (send shift-register :new (copies delay 'nil)))
(simrep (n (length source))
(prog1
(at (* n speed)
(sim (pan
(if (send sr :get-node)
(pluck (+ (send sr :get-node) 12) 0.50)
(s-rest))
0.90)
(pan
(pluck (nth n source) 0.50)
0.10)))
(send sr :step (nth n source))))))
;; Example 5 shows how to use a 2-stage register to produce the Fibonacci
;; sequence. Not particularly piratical.
;;
(defun sr-test-5 (&optional (n 10))
(let (sr)
(setf sr (send shift-register :new '(1 1)))
(send sr :tap 0 't)
(send sr :tap 1 't)
(format t "~%Fibonacci: ")
(dotimes (i n)
(format t "~a " (send sr :get-node))
(send sr :step))
(format t "~%")))
;; shift-register.lsp
;; Version 1.00 11 March 2005
;; Author Steven Jones
;;
;; Contact jones57@swbell.net include the word "nyquist" in subject line
;;
;; The contents of this file are released under the terms of the GNU General
;; Public License. See the file LICENSE.txt
;;
;; Defines a class for simulating shift-registers. A shift register consist
;; of a series of nodes (cells/stages?) linked in a linear configuration.
;;
;; [ ]-->[ ]-->[ ]--> ... -->[ ]
;;
;;
;; When shifted the contents of each cell replaces the previous contents of the
;; cell to its right. Practical applications include the conversion between
;; parallel and serial data streams and the production of pseudo-random
;; numbers.
;;
;; Adding feedback taps at various stages greatly increases the register's
;; complexity. Its possible for registers to produce complex numeric
;; sequences ranging from highly predictable to pseudo-random.
;;
;; Typically the sum of the feedback stages, usually to some modulo, is placed
;; into the initial cell on each shift operation.
;;
;; In this implementation the user provides a feedback function and the
;; register cells may contain any data type with the provision that the
;; feedback function expects that type. Usually the cells contents are
;; numeric.
;;
;; See below for several usage examples.
;;
(provide 'shift-register)
(current-file "shift-register")
;; @doc class shift-register
;; Simulation of a shift register.
;; Instance variables are:
;; .register - A list which represents the registers current state.
;; .taps - A list Boolean flags of the same length as .register.
;; A true flag indicates that a specific cell contributes to
;; the feedback when the register is shifted.
;; .fbfn - The feedback function proper, default is simple addition
;; .advance-hook - A function which is applied to the register contents after they are shifted.
;; The hook does not effect the register proper but provides additional
;; processing of the registers output.
;;
(setf shift-register (send class :new '(.register .taps .fbfn .advance-hook)))
;; @doc method shift-register :new
;; (send shift-register :new seed)
;; Construct new shift register
;;
;; seed - List. The seed list determines both the registers length as well
;; as its initial state.
;;
;; return - Object. A new instance of shift-register
;;
(send shift-register :answer :isnew '(seed)
'((setf .register seed)
(setf .taps (copies (length seed) 'nil))
(setf .fbfn #'+)
(setf .advance-hook #'(lambda (&rest args) args))
))
;; @doc method shift-register :tap
;; (send /shift-register/ :tap n flag)
;; Add (remove) feedback tap.
;;
;; n - Integer. The stage to be effected. 0 <= n < (length seed)
;;
;; flag - Boolean. True if stage n is to be tapped.
;;
;; return - Nil.
;;
(send shift-register :answer :tap '(n flag)
'((setf (nth n .taps) flag)))
;; @doc method shift-register :length
;; (send /shift-register/ :length)
;; return - integer. The number of stages in the register
;;
(send shift-register :answer :length '()
'((length (.register))))
;; @doc method shift-register :get-state
;; (send /shift-register/ :answer :get-state)
;; return - List. The current state of the register
;;
(send shift-register :answer :get-state '()
'(.register))
;; @doc method shift-register :set-state
;; (send /shift-register/ :answer :set-state seed)
;; Initialize (seed) the registers state.
;;
;; seed - list. A list containing the registers new state. The length of
;; seed must equal the original length of the register.
;;
(send shift-register :answer :set-state '(seed)
'((if (not (= (length seed)(length .taps)))
(error "You must seed shift-register with list of same length as the register")
(setf .register seed))))
;; @doc method shift-register :get-node
;; (send /shift-register/ :get-node [n])
;; Get the contents of specific register node.
;;
;; n - Integer. The nodes index. 0 <= n < length
;; Defaults to the final node.
;;
;; return - Any. The contents of node n.
;;
(send shift-register :answer :get-node '(&optional (n nil))
'((nth (or n (length (cdr .register))) .register)))
;; @doc method shift-register :set-node
;; (send /shift-register/ :set-node n val)
;; Set value of specific register node.
;;
;; n - Integer. The nodes index
;; val - Any.
;;
(send shift-register :answer :set-node '(n val)
'((setf (nth n .register) val)))
;; @doc method shift-register :fbfn
;; (send /shift-register/ :fbfn fn)
;; Set the feedback function.
;;
;; fn - Closure. The feedback function must have the form
;; (lambda (&rest args) ...)
;; The default function is
;; (lambda (&rest args)(apply #'+ args))
;; Another useful function is
;; (lambda (&rest args)(rem (truncate (apply #'+ args)) c))
;; where c is a positive integer.
;;
;; return - Nil.
;;
(send shift-register :answer :fbfn '(fn)
'((setf .fbfn fn)))
;; @doc method shift-register :advance-hook
;; (send /shift-register/ :advance-hook fn)
;; Set the output processing hook. The advance method is used to shift the
;; register one complete cycle and then returns a list containing the
;; registers current state. advance-hook is used to process this list prior to
;; returning it. The default hook is the identity.
;; (lambda (&rest args) args)
;;
(send shift-register :answer :advance-hook '(fn)
'((setf .advance-hook fn)))
;; @doc method shift-register :aggregate-taps
;; (send /shift-register/ :aggregate-taps [inject])
;; Build a list from the tapped cells. The inject value may be used to place a
;; new value into the register during the feedback process.
;;
;; inject - Any. Default 0
;;
;; return - List.
;;
(send shift-register :answer :aggregate-taps '(&optional (inject 0))
'((let (args)
(setf args (list inject))
(dotimes (i (length .taps))
(if (nth i .taps)
(push (nth i .register) args)))
args)))
;; @doc method shift-register :determine-feedback-object
;; (send /shift-register/ :determine-feedback-object [inject])
;; Aggregate the tapped nodes into a list along with the inserted value, then
;; apply the feedback function.
;;
;; inject - Any. Default 0
;; return - Any.
;;
(send shift-register :answer :determine-feedback-object '(&optional(inject 0))
'((let (args) (setf args (send self :aggregate-taps inject))
(apply .fbfn args))))
;; @doc method shift-register :step
;; (send /shift-register/ :step [inject])
;; Advance register contents by one stage. Prior to advancing the register the
;; tapped stage values are aggregated along with the injected value, and the
;; fbfn applied. The result is inserted into the initial node after the
;; shifting operation is completed.
;;
;; inject - Any. Default 0
;; return - Nil
;;
(send shift-register :answer :step '(&optional (inject 0))
'((let (fb)
(setf fb (send self :determine-feedback-object inject))
(do ((index (- (length .register) 1)(- index 1)))
((zerop index))
(setf (nth index .register)
(nth (- index 1) .register))
)
(setf (car .register) fb)
)))
;; @doc method shift-register :advance
;; (send /shift-register/ :advance [n [inject]])
;; Cycle the entire registers contents n times.
;;
;; n - Integer. The number of times to cycle the register, default 1
;;
;; inject - Any. The feedback injection value, default 0.
;;
;; return - Any. After the register has been cycled n times the register
;; contents, i the form of a list, are processed by the
;; advance-hook function. The result of the hook serves as the return
;; value. By default the result is a list containing th register
;; current state.
;;
(send shift-register :answer :advance '(&optional (n 1)(inject 0))
'((dotimes (i (* n (length .register)))
(send self :step))
(apply .advance-hook .register)))
;; @doc method shift-register :rep
;; (send /shift-register/ :rep [echo])
;; Return or display a string representation of the registers current state.
;;
(send shift-register :answer :rep '(&optional (echo t))
'((let (acc)
(setf acc (format nil "~a" .register))
(format echo "~%~a" acc))))
#|
;; @doc example shift-register
;; In the first example we seed the register with a simple c 7th arpeggio and
;; only tab the final node for feedback. We also inject the value 1 into the
;; register on each shift operation. The feedback function takes the sum of
;; the final stage and the injected value, effectively transposing by 1/2
;; step. However the fb function uses the rem function to return only
;; remainder of the addition after dividing by 12. Using the rem function is
;; often useful to keep the register values in bounds. Being a deterministic
;; structure the outcome has a period after which it repeats. In this case the
;; default argument values produce a period of 60 events.
;;
(defun sr-test-1 (&key (reps 60)(seed (list c5 bf4 g4 e4 c4))(speed 0.12)(inject 1))
(let (sr val)
(setf sr (send shift-register :new seed))
(send sr :tap (1- (length seed)) 't)
(send sr :fbfn #'(lambda (&rest args)
(+ c4 (rem (truncate (apply #'+ args)) 12))))
(simrep (rep reps)
(progn
(setf val (send sr :get-node))
(send sr :step inject)
(format t "~%at ~a X ~a step ~a" rep speed val)
(at (* rep speed)(cue (pluck val speed)))))))
;; Example 2 is like example 1 except we include taps from stages 1 and 2 and
;; by default inject 0 on each shift. The fb function has been modified to
;; provide a greater range of output values. The result is a bit more
;; meandering but still maintenance some order.
;;
;; Notice we shift the register 120 times before using it. At times you may
;; want to "pre-run" the register so that it settles down into a regular
;; pattern. This may or may not be one of those times.
;;
(defun sr-test-2 (&key (reps 60)(seed (list c5 bf4 g4 e4 c4))(speed 0.12)(inject 0))
(let (sr val)
(setf sr (send shift-register :new seed))
(send sr :tap (1- (length seed)) 't)
(send sr :tap 1 't)
(send sr :tap 2 't)
(send sr :fbfn #'(lambda (&rest args)
(+ c4 (rem (truncate (apply #'+ args)) 18))))
(dotimes (dummy 120)
(send sr :step inject))
(simrep (rep reps)
(progn
(setf val (send sr :get-node))
(send sr :step inject)
(format t "~%at ~a X ~a step ~a" rep speed val)
(at (* rep speed)(cue (pluck val speed)))))))
;; For example 3 only the final stage is tapped and by default the injected
;; value is 0. The fb function returns a slightly randomized version of its
;; arguments. The result is a regular pattern with slight random transposition
;; on each iteration.
;;
(defun sr-test-3 (&key (reps 60)(seed (list c5 bf4 g4 e4 c4))(speed 0.12)(variance 0.005)(inject 0))
(let (sr val)
(nice-load "math")
(setf sr (send shift-register :new seed))
(send sr :tap (1- (length seed)) 't)
(send sr :fbfn #'(lambda (&rest args)
(let* ((step (apply #'+ args))
(delta (* step variance)))
(+ step (* (rnd) delta)))))
(simrep (rep reps)
(progn
(setf val (send sr :get-node))
(send sr :step inject)
(at (* rep speed)(cue (pluck val speed)))
))))
;; In example 4 we use a register without feedback as a delay line. The source
;; material are a few notes from Bach. In one channel the melody is played
;; directly from the source list. The other channel is transposed up an octave
;; and delayed by the length of the register. One advantage this type of delay
;; over an audio delay is that the delayed sound need not be the same as the
;; non-delayed sound. Of course the register may also be tapped at
;; intermediate stages to provide additional output.
;;
(defun sr-test-4 (&key (delay 6)(speed 0.12))
(let (sr source)
(setf source (list a4 g4 fs4 a4 g4 a4 d4
b4 a4 fs4 b4 a4 b4 e4
c5 c5 b4 g4 e4 fs4 g4
fs4 e4 fs4 g4 g4 e4 cs4 d4))
(setf sr (send shift-register :new (copies delay 'nil)))
(simrep (n (length source))
(prog1
(at (* n speed)
(sim (pan
(if (send sr :get-node)
(pluck (+ (send sr :get-node) 12) 0.50)
(s-rest))
0.90)
(pan
(pluck (nth n source) 0.50)
0.10)))
(send sr :step (nth n source))))))
;; Example 5 shows how to use a 2-stage register to produce the Fibonacci
;; sequence. Not particularly piratical.
;;
(defun sr-test-5 (&optional (n 10))
(let (sr)
(setf sr (send shift-register :new '(1 1)))
(send sr :tap 0 't)
(send sr :tap 1 't)
(format t "~%Fibonacci: ")
(dotimes (i n)
(format t "~a " (send sr :get-node))
(send sr :step))
(format t "~%")))