;nyquist plug-in
;version 1
;type analyze
;categories "http://lv2plug.in/ns/lv2core#AnalyserPlugin"
;name "Find Phonemes..."
;action "Finding sound..."
;info
;control control-minimum-ms "Label regions not shorter than" real "ms" 20 0 1000
;control control-percentage "... in which the" real "-th percentile" 75 0 100
;control control-abovebelow "... of the power spectrum lies" choice "Above,Below" 1
;control control-frequency "... the frequency" real "Hz" 7000.0 0.1 22000
;control control-window-length "Window Length (samples)" int "" 256 8 32768
;control control-skip-length "Skip Length (cycles)" int "" 32 1 32768
;control control-window-choice "Window Type" choice "Hann,Rectangular" 0
;;unused
;;control control-amplitude "Amplitude (dB)" real "" -24 -60 0
(defun eliminate-short-label (label-list minimum-seconds)
(if (or (null label-list)
(>= (- (cadar label-list) (caar label-list)) minimum-seconds))
label-list
(rest label-list)))
(defun push-label (label-list minimum-seconds
start end
length-samples skip-samples srate
name separator)
;; find the times in seconds that delimit the start of the start-th frame
;; and the end of the end-th frame
;; do not make touching or overlapping labels
(let* ((sample-period (/ 1.0 srate))
(scaled-start (* sample-period start skip-samples))
(scaled-end (* sample-period (+ length-samples (* end skip-samples)))))
(cond
((or (null label-list) (> scaled-start (cadar label-list)))
;; new label
;; decide now whether to eliminate the PREVIOUS label,
;; but not the new one
(cons (list scaled-start scaled-end name)
(eliminate-short-label label-list minimum-seconds)))
(T
;; overlap or touch the previous label, so extend it
(cons (list (caar label-list) scaled-end
(strcat (caddar label-list) separator name))
(rest label-list))))))
;;; last arg is a function taking a frame and returning a boolean
(defun scan-frames (snd minimum-seconds length-samples skip-samples
window should-label)
(let ((my-s (snd-copy snd))
(srate (snd-srate snd))
result
start-of-label)
(do ((n 0 (1+ n))
(frame (snd-fft my-s length-samples skip-samples window)
(snd-fft my-s length-samples skip-samples window)))
((not (arrayp frame))
(if (not start-of-label)
(eliminate-short-label result minimum-seconds)
(push-label result minimum-seconds start-of-label (1- n)
length-samples skip-samples srate
"" "")))
(let ((inside (funcall should-label frame)))
(cond ((and inside (not start-of-label))
;; transition in
(setq start-of-label n))
((and (not inside) (numberp start-of-label))
;; transition out
(setq
result (push-label result minimum-seconds start-of-label (1- n)
length-samples skip-samples srate
"" "")
start-of-label nil)))))))
;;; takes an array, returns an array.
;;; We will examine odd-numbered members of the output and ignore the evens.
;;; Array member 1 will be proportional to energy in DC band,
;;; 3 to energy in DC plus first sine and cosine, 5 to that plus second, etc.
(defun cumul-power-spectrum (frame)
;; make dc comparable to the other components
(setf (aref frame 0) (* 0.5 (aref frame 0)))
(let* ((snd (snd-from-array 0.0 1.0 frame)) ; the array as a sound
(sndsq (mult snd snd)) ; the squares
;; following finds partial sums, always gives 0 in first
;; place, and ignores the last component of sndsq which is
;; the Nyquist frequency. Would divide it by 2 first as with DC
;; and pad with a zero if I cared.
(integral (integrate sndsq))
(len (length frame)))
;; be nice and leave no net side effect.
(setf (aref frame 0) (* 2 (aref frame 0)))
;; convert sound back to an array.
(snd-fetch-array integral len len)))
(defun scan-for-frequency (snd
minimum-seconds fraction
abovebelow freq-hz
;;amp-db
length-samples skip-samples
window-choice)
(let* ((srate (snd-srate snd))
(period-samples (/ srate freq-hz))
;;stuff from a different experiment
;; (length-samples (truncate (* length-cycles period-samples)))
;; (skip-samples (truncate (* skip-cycles period-samples)))
(length-cycles (/ length-samples period-samples))
;; offset in frames of the interesting coefficients
;; round off the period to the nearest bucket
(index-even (* 2 (truncate (+ 0.5 length-cycles))))
(index-odd (1- index-even))
(window
(case window-choice
(0 (let ((length-seconds (/ length-samples srate)))
(mult 0.5 (sum 1 (osc (hz-to-step (/ length-seconds))
length-seconds *sine-table* -90)))))
(1 nil)))
;; ignore this stuff from a different experiment
;; ;; take the threshold in dB, convert to linear, and multiply
;; ;; by length-samples / 2 to make it comparable
;; ;; to the coefficients computed
;; ;; by fft which have the same factor in them (apart from dc and
;; ;; Nyquist frequencies for which it is length-samples).
;; (amp-linear (db-to-linear amp-db))
;; (amp-linear-scaled (* amp-linear length-samples 0.5))
;; (ampsq (* amp-linear-scaled amp-linear-scaled))
;; (my-fun
;; #'(lambda (frame)
;; (let* ((coeff-odd (aref frame index-odd))
;; (coeff-even (aref frame index-even))
;; (coeffsq (+ (* coeff-odd coeff-odd)
;; (* coeff-even coeff-even))))
;; (>= coeffsq ampsq))))
(my-fun2
#' (lambda (frame)
(let* ((len (length frame))
(sums (cumul-power-spectrum frame))
(nsums (length sums))
(sum (aref sums (1- nsums)))
(threshold (* fraction sum))
;; scan sums for first ODD entry at or above threshold,
;; then return the EVEN index into frame for the
;; coefficient pair for that frequency
(index (do ((n 0 (+ 2 n)))
((or (>= (1+ n) nsums)
(>= (aref sums (1+ n)) threshold)) n))))
(if (= abovebelow 0)
(>= index index-even)
(<= index index-even))))))
(scan-frames snd
minimum-seconds length-samples skip-samples window my-fun2)))
(or
(scan-for-frequency s
(/ control-minimum-ms 1000.0) (/ control-percentage 100.0)
control-abovebelow control-frequency
; control-amplitude
control-window-length control-skip-length
control-window-choice)
"Found nothing")