;;; Find zero crossings, without writing inner loops in Lisp. Warning, relies
;;; on undocumented behavior of snd-inverse.
;;;
;;; snd is a sound
;;;
;;; choice is 0 for a random-access nearest-crossing finder function that
;;; takes a global time and returns global time or nil;
;;; 1 for an iterator function taking no arguments that returns
;;; (with successive calls) an increasing sequence of global times and then nil.
;;;
;;; Boundary behavior:
;;; The time of the first sample, if that is below tiny and not negative,
;;; and right of the last sample, if that is above -tiny and not positive,
;;; will be reported as a crossing; pass -1 to tiny to suppress that.
(defun make-upward-zero-crossing-finder (snd
choice
&optional (tiny (db-to-linear -55)))
(let*
((t0 (snd-t0 snd))
(srate (snd-srate snd))
(sample-time (/ (* 2 srate)))
(blip (snd-from-array 0 srate (vector srate)))
(blips (trigger snd blip))
;; trigger finds transitions from non-positive to
;; positive. But whenever the first sample
;; is positive, it is also treated as a crossing. Reject this
;; spurious crossing unless the first sample is "tiny."
(bogus-crossing-at-t0 (>= (snd-sref snd t0) tiny))
;; beware, integrate always puts 0 in the first sample of the result,
;; and neglects the last sample of the input; unless input is empty,
;; which makes the result empty too.
(count-of-crossings-snd (integrate blips))
;; count-of-crossings array contains what should be
;; integers, computed as floats -- be careful to round off.
;; Because of the initial 0 always made by integrate,
;; (aref count-of-crossings-array index)
;; is the count of upward zero transitions BEFORE
;; index, not AT OR BEFORE.
(count-of-crossings-array (snd-samples count-of-crossings-snd ny:all))
(count-of-crossings-len (length count-of-crossings-array))
(last-count
(and (plusp count-of-crossings-len)
(aref count-of-crossings-array (1- count-of-crossings-len))))
;; Should we report a crossing at or past the end? Find a time or nil.
;; This also compensates for the case of loss of the last sample
;; to integrate. The last sample would change the summation if and
;; only if there is a transition AT (not past) the last sample,
;; which we can detect here.
;; If not, the highest value of integrate is attained
;; before the last sample and does get seen by snd-inverse;
;; though possibly ignored by it, which is compensated for
;; elsewhere.
(extra-crossing
(let ((s-len (snd-length snd ny:all)))
(and (plusp s-len)
(let* ((tn (+ t0 (/ (1- s-len) srate)))
(sample (snd-sref snd tn)))
(if (plusp sample)
(and (> s-len 1)
(not (plusp
(snd-sref snd (- tn sample-time))))
;; a rising transition at the very last
;; sample, which is non-negative
tn)
(and (> sample (- tiny))
;; the last sample is slightly negative, so
;; call it an upward crossing just past the end.
(+ tn sample-time))))))))
(if
(or (not last-count) ;empty sound
(and (not extra-crossing)
(or (= last-count 0) ;no real crossings
(and bogus-crossing-at-t0 (= last-count 1)))))
;only bogus crossing
;; there are no crossings
(case choice (0 #'(lambda (time) nil)) (1 #'(lambda () nil)))
;; more work to define the function...
(let*
((inv-snd (snd-inverse count-of-crossings-snd 0 1))
;; notes about snd-inverse: when the given function is not
;; strictly increasing, the inverse is underdetermined. Behavior
;; of snd-inverse appears to be that the time of the LAST sample
;; for each value the function attains is the answer given
;; by snd-inverse. I rely on this assumption!
;; Also snd-inverse seems SOMETIMES to neglect the last sample
;; of input, and sometimes not.
;; Therefore: take (aref count-of-crossings-array index), then
;; aref inv-array at that value (if it exists), and you get the
;; time of the first upward transition AT OR AFTER index.
(inv-array (snd-samples inv-snd ny:all)))
;; find the nearest crossing to either side
;; or return nil if out of bounds
(case
choice
(0
;; random access nearest-crossing finder
#'(lambda (time)
(let* ((tt (- time t0))
(index0 (truncate (+ 0.5 (* tt srate)))))
;; bounds check for valid time interval
(and
(>= index0 0)
(< index0 count-of-crossings-len)
(let*
( ;; Find the time of the first transition AFTER
;; index0 (which is at or after the next index).
;; Or, nil.
(index (if (= index0 (1- count-of-crossings-len))
;; oops, we bump against the problem
;; of the lost sample in integrate.
;; But we compensate with
;; extra-crossing.
index0
(1+ index0)))
(num (truncate
(+ 0.5 (aref count-of-crossings-array index))))
;; in case num equals last-count, again rely on
;; extra-crossing.
(t-after (if (< num last-count)
(aref inv-array num)
extra-crossing))
;; Are there any real crossings at or before
;; index?
(should-look-left
(not (or (zerop num)
(and (= num 1) bogus-crossing-at-t0))))
;; Time of the first real transition
;; AT OR BEFORE index 0, or nil:
(t-before
(and should-look-left
(aref inv-array (1- num)))))
(if (and t-before
(or (not t-after)
(< (- time t-before) (- t-after time))))
t-before
t-after))))))
(1
;; iterator, a function with state
(let ((num (if bogus-crossing-at-t0 1 0))
(last (length inv-array))
(extra extra-crossing))
#'(lambda ()
(cond ((< num last)
(prog1 (aref inv-array num)
(setq num (1+ num))))
((numberp extra)
(prog1 extra (setq extra nil)))
(t nil))))))))))