; rhythmfunctions.cl
; derivation of rhythm/duration elastics procedures for guitar/flute duo project
; updated 11.24.2000
#|
fractalization: expanding a series of durations valued in absolute time
(seconds)
no rest handling implemented
master function: (fractalize-time)
dependencies: (fractalize-time-helper), (scale-absolute-time), (scale),
(sum-durations)
example: (fractalize-time '(1 2 3 4))
creates four sequences of four durations; the proportions within each subsequence
and the of the total length of each subsequence match (1 2 3 4).
|#
(defun fractalize-time (durations)
(fractalize-time-helper durations durations))
(defun fractalize-time-helper (duration-series target-durations)
(if target-durations
(append (list (scale-absolute-time duration-series (car target-durations)))
(fractalize-time-helper duration-series (cdr target-durations)))
nil))
(defun scale-absolute-time (durations target-time)
(let* ((scaler (/ target-time (sum-durations durations))))
(scale durations scaler)))
#|
fractalization: expanding a series of durations valued in absolute time (seconds)
rests implemented as single-valued lists
master function: (fractalize-time-with-rests)
dependencies: (fractalize-two-series), (scale-absolute-time-with-rests),
(scale-with-rests), (sum-durations-with-rests)
example: (fractalize-time-with-rests '(1 (2) 3 4))
works in the same way as (fractalize-time) but singles out the (2) duration as
a rest, rather than as a value to be filled.
|#
(defun fractalize-time-with-rests (durations)
(fractalize-two-series durations durations))
(defun fractalize-two-series (duration-series target-durations)
(if target-durations
(if (listp (car target-durations))
(append (list (car target-durations))
(fractalize-two-series duration-series (cdr target-durations)))
(append (list (scale-absolute-time-with-rests duration-series (car target-durations)))
(fractalize-two-series duration-series (cdr target-durations))))
nil))
(defun scale-absolute-time-with-rests (durations target-time)
(let* ((scaler (/ target-time (sum-durations-with-rests durations))))
(scale-with-rests durations scaler)))
(defun scale-with-rests (durations scaler)
(if durations
(if (listp (car durations))
(append (list (list (* (car (car durations)) scaler)))
(scale-with-rests (cdr durations) scaler))
(append (list (* (car durations) scaler))
(scale-with-rests (cdr durations) scaler)))
nil))
(defun sum-durations-with-rests (durations)
(if durations
(if (listp (car durations))
(+ (car (car durations)) (sum-durations-with-rests (cdr durations)))
(+ (car durations) (sum-durations-with-rests (cdr durations))))
0))
#|
fractalize the fractals
master-function: fractalize-again
dependencies: the fractalize-time-with-rests tree
example:
(fractalize-again (fractalize-time-with-rests '(1 (2) 3 4)) '(1 2))
splits each element produced by (fractalize-time-with-rests) into two unequal units
with a proportion of 1:2
|#
(defun fractalize-again (duration-lists fractal-model)
(if duration-lists
(if (> (length (car duration-lists)) 1)
(append (fractalize-two-series fractal-model (car duration-lists))
(fractalize-again (cdr duration-lists) fractal-model))
(append (list (car duration-lists))
(fractalize-again (cdr duration-lists) fractal-model)))))
#|
locate absolute time durations within tempo/beat containers
rests and phrase hierarchies removed at present
(could be reinserted via comparison with original duration lists)
master function: (times-to-beats)
dependencies: (flatten-durations), (add-zero), (durations-to-onsets), (find-beats)
(round-durations-to-grid), (round-to-grid)
example:
(times-to-beats '(0.9 1.8 1.8 0.9 4.0) '(60 120) '(4 12) 0.125)
maps durations (in seconds) into two tempos: 4 beats at mm=60 and 12 beats at mm=120,
rounding to the nearest 32nd note (0.125)
|#
(defun times-to-beats (durations section-tempi section-beats grid)
(round-durations-to-grid (find-beats (flatten-durations durations)
section-tempi
section-beats
0)
grid))
(defun flatten-durations (durations)
(cond ((null durations) nil)
((atom durations) durations)
((listp (car durations))
(append (flatten-durations (car durations))
(flatten-durations (cdr durations))))
(t (append (list (car durations))
(flatten-durations (cdr durations))))))
(defun add-zero (durations)
(append (list 0) durations))
(defun find-beats (onsets section-tempi section-beats carried-beats)
(if (and onsets section-tempi section-beats (>= (length onsets) 2))
(let* ((current-tempo-scaler (/ (car section-tempi) 60))
(current-section-beats (car section-beats))
(current-section-time (/ current-section-beats current-tempo-scaler))
(next-onset (car onsets)))
(if (> next-onset current-section-time)
(find-beats (change-first-element (- next-onset current-section-time)
onsets)
(cdr section-tempi)
(cdr section-beats)
(+ carried-beats current-section-beats))
(add-first-element (+ (* next-onset current-tempo-scaler)
carried-beats)
(find-beats (cdr onsets)
section-tempi
(change-first-element (- (car section-beats) (* next-onset current-tempo-scaler))
section-beats)
0))))
nil))
; scaling operations: stretch an existing duration list to fit a new total duration
; master function: scale-durations
(defun scale-durations (durations grid target-duration)
(let* ((scaler (/ target-duration (sum-durations durations))))
(remove-zeros (fix-rounding-errors (round-durations-to-grid (scale durations scaler) grid) grid target-duration))))
(defun scale (durations scaler)
(if (not durations)
nil
(append (list (* (car durations) scaler)) (scale (cdr durations) scaler))))
(defun round-durations-to-grid (duration-list grid)
(if (not duration-list)
nil
(append (list (round-to-grid (car duration-list) grid))
(round-durations-to-grid (cdr duration-list) grid))))
(defun round-to-grid (duration grid)
(let* ((multiple-part (truncate (/ duration grid)))
(remainder-part (mod duration grid)))
(+ (* multiple-part grid) (* (round remainder-part grid) grid))))
; fix-rounding-errors resolves error by truncating/adding to end of duration list
(defun fix-rounding-errors (durations grid target-duration)
(let* ((deviation (- (sum-durations durations) target-duration))
(last-duration (car (last durations))))
(cond ((> deviation 0)
(if (>= deviation last-duration)
(fix-rounding-errors (butlast durations) grid target-duration)
(change-last-element (- last-duration deviation) durations)))
((< deviation 0)
(change-last-element (+ last-duration deviation) durations))
(t durations))))
; fix-rounding-errors2 attempts to distribute error evenly across duration list
(defun fix-rounding-errors2 (durations grid target-duration)
(let* ((deviation (- (sum-durations durations) target-duration)))
(if (= deviation 0)
durations
(spread-deviation durations grid (round-to-grid deviation grid)))))
(defun spread-deviation (durations grid deviation)
(cond ((> deviation 0)
(append (list (- (car durations) grid))
(spread-deviation (cdr durations) grid (- deviation grid))))
((< deviation 0)
(append (list (+ (car durations) grid))
(spread-deviation (cdr durations) grid (+ deviation grid))))
(t durations)))
(defun sum-durations (durations)
(if (not durations)
0
(+ (car durations) (sum-durations (cdr durations)))))
(defun remove-zeros (durations)
(if (not durations)
nil
(if (= 0 (car durations))
(remove-zeros (cdr durations))
(add-first-element (car durations) (remove-zeros (cdr durations))))))
(defun durations-to-onsets (durations)
(cond ((null durations) nil)
((= (length durations) 1) durations)
(t (add-first-element (car durations)
(durations-to-onsets (change-first-element (+ (car durations)
(cadr durations))
(cdr durations)))))))
; primitive list constructors
(defun change-first-element (new-first existing-list)
(append (list new-first) (cdr existing-list)))
(defun add-first-element (additional-first existing-list)
(append (list additional-first) existing-list))
(defun change-last-element (new-last existing-list)
(append (butlast existing-list) (list new-last)))
; primitive function for neatly printed output
(defun printer (list)
(write-to-string list :right-margin 72))