Audacity Support Forum /
Audacity and Nyquist /
Nyquist Reference Manual /
Nyquist Examples and Tutorials
Simple Compressor Example /
Speech Compressor Example
; This code implements a compressor for noisy speech audio.
; There are actually two compressors that can be used in
; series. The first is
; a fairly standard one: it detects signal level with an RMS
; detector and used table-lookup to determine how much gain
; to place on the original signal at that point. One bit of
; cleverness here is that the RMS envelope is "followed" or
; enveloped using SND-FOLLOW, which does look-ahead to anticipate
; peaks before they happen.
;
; The other piece of high-tech is COMPRESS-MAP, which builds
; a map in terms of compression and expansion. What I recommend
; is figure out the noise floor on the signal you are compressing.
; Use a compression map that leaves the noise alone and boosts
; signals that are well above the noise floor. Alas, the COMPRESS-MAP
; function is not written in these terms, so some head-scratching is
; involved. Maybe I'll write another map generator if someone has a
; good application to test with.
; COMPRESS-MAP -- constructs a map for the compress function
;
; The map consists of two parts: a compression part and an expansion part.
; The intended use is to compress everything above compress-threshold by
; compress-ratio, and to downward expand everything below expand-ratio
; by expand-ratio. Thresholds are in dB and ratios are dB-per-dB.
; 0dB corresponds to a peak amplitude of 1.0 or rms amplitude of 0.7
; If the input goes above 0dB, the output can optionally be limited
; by setting :limit (a keyword parameter) to T. This effectively changes
; the compression ratio to infinity at 0dB. If :limit is NIL
; (the default), then the compression-ratio continues to apply above 0dB.
;
; Another keyword parameter, :transition, sets the amount below the
; thresholds (in dB) that a smooth transition starts. The default is 0,
; meaning that there is no smooth transition.
;
; It is assumed that expand-threshold <= compress-threshold <= 0
; The gain is unity at 0dB so if compression-ratio > 1, then gain
; will be greater than unity below 0dB
; RETURNS: a sound for use in the SHAPE function. The sound maps input
; dB to gain. Time 1.0 corresponds to 0dB, and Time 0.0 corresponds to
; -100 dB, and Time 2.0 corresponds to +100dB, so this is a
; 100hz "sample rate" sound. The sound gives gain in dB.
; Smooth transition equations: this is a parabola that makes a
; transition between two intersecting straight lines. The parabola
; matches the slope of the lines where it intersects them, and
; it intersects the first (left) line at location (u, v). The equation
; is:
; y = v + m(x-u) + d(s-m)((x-u)/d - (x-u)^2/(2d^2))
; = v + m(x-u) + (s-m)((x-u) - (x-u)^2/(2d))
; = v + m(x-u) + (s-m)((x-u) - (x-u)^2(s-m)/(4(b-v)))
;
; where s is the slope of the left line, the right line is expressed by
; y = mx+b, and
; d is the duration of the transition = 2(b-v)/(s-m)
;
; To show this is correct, show that (1) at the left intersection, the left
; line and the transition both pass through u,v and (2) have the same slope s,
; and show that (3) at the right intersection, the right line and the
; transition both meet at u+d and (4) have the same slope m.
;
; transition runs from u,v on left line to u+d on right line
; d = 2(v - mu - f)/(m - s),
; where right line is described by y = mx + f and left line slope = s
; c = (m - s)/2d
; b = s - 2cu
; a = v - bu - cu^2
;
; transition is y = a + bx + cx^2
;
; Now, show that curve meets left line at x = u
; (1) a + bx + cx^2 = v at x = u
; a + bu + cuu = v - bu - cuu + bu + cuu = v
;
; (2) slope at x = u is s:
; b + 2cu = s - 2cu + 2cu = s
;
; (3) curve meets right line at x = u + d
; a + b(u + d) + c(uu + 2ud + dd) =
; v - bu - cuu + bu + bd + cuu + 2cud + cdd =
; v + bd +2cud + cdd =
; v + (s - 2cu)d + 2cud + cdd =
; v + sd + cdd =
; v + sd + dd(m-s)/2d =
; v + sd + d(m-s)/2 =
; v + s(2(v - mu - f)/(m - s)) + (2(v - mu - f)/(m - s))(m-s)/2 =
; v + 2sv/(m-s) -2smu/(m-s) -2sf/(m-s) + v - mu - f =
; 2v + (2sv - 2smu - 2sf)/(m-s) - mu - f =
; 2v + 2s(v - mu - f)/(m-s) - mu - f =
; 2v + sd - mu - f
; try subtracting mx + b':
; 2v + sd - mu - f - m(u + d) - f =
; 2v + sd - 2mu - 2f - md =
; 2v + (s - m)d - 2mu - 2f =
; 2v + (s - m)2(v - mu - f) / (m - s) - 2mu - 2f =
; 0
;
(defun compress-map (compress-ratio compress-threshold expand-ratio
expand-threshold &key (limit nil) (transition 0.0))
(display "compress-map" compress-ratio compress-threshold expand-ratio
expand-threshold limit transition)
(let (m s ; see equations above
eupd ; eu + d
cupd ; ct1 + d
lim ; 0dB or infinity, depends on limit
b2 ; y-intercept of the 1:1 part
ea eb ec ca cb cc ; polynomial coefficients
eu ev cu cv ; intersection points (u,v)
ed cd ; d values
lower-db upper-db ; function to compute
map ; samples for map
x ; loop value
den ; denominator
)
; check input for good values:
(cond ((> expand-threshold compress-threshold)
(error "expand-threshold must be lower than compress threshold"))
((> compress-threshold 0)
(error "compress-threshold must be at or below 0dB"))
((<= compress-ratio 0.0)
(error "negative compress-ratio"))
((< expand-ratio 0.0)
(error "negative expand-ratio"))
)
; set some constants
(setf eu (- expand-threshold transition))
(setf cu (- compress-threshold transition))
(setf m (/ 1.0 compress-ratio))
(setf s expand-ratio) ; rename to match equations
; point where compression line intersects non-compression
; line is (* m compress-threshold), and cv is this point
; minus transition (since slope is one)
(setf cv (- (* m compress-threshold) transition))
; slope is 1 from compress-threshold to expand-threshold
(setf ev (+ (* m compress-threshold)
(- expand-threshold compress-threshold)
(* s (- transition))))
; the 1:1 part passes through cu,cv with slope of 1, so the y-intercept
; is cv-cu
(setf b2 (- cv cu))
; d = 2(v - mu - f)/(m - s) --note m = s, s = 1, f = 0
(setf den (- m 1.0))
(cond ((< (abs den) .001)
(setf cd 0.0))
(t
(setf cd (* 2 (- cv (* cu m)) (/ den)))))
(setf cupd (+ cu cd))
(setf den (- 1.0 s))
(cond ((< (abs den) .001)
(setf ed 0.0))
(t
(setf ed (* 2 (- ev eu b2) (/ den)))))
(setf eupd (+ eu ed))
; ec = (1.0 - s)/(2*ed)
(cond ((< (abs ed) 0.001)
(setf ec 0.0))
(t
(setf ec (/ (- 1.0 s) (* 2.0 ed)))))
; eb = s - 2*ec*eu
(setf eb (- s (* 2.0 ec eu)))
; ea = ev - eb*eu - ec*eu*eu
(setf ea (- ev (* eb eu) (* ec eu eu)))
; cc = (m - 1.0)/(2*cd)
(cond ((< (abs cd) 0.001)
(setf cc 0.0))
(t
(setf cc (/ (- m 1.0) (* 2.0 cd)))))
; cb = s - 2*cc*cu
(setf cb (- 1.0 (* 2.0 cc cu)))
; ca = cv - cb*cu - cc*cu*cu
(setf ca (- cv (* cb cu) (* cc cu cu)))
(cond (limit ; hard limit to 0dB
(setf lim 0.0))
(t ; no hard limit, set limit to effectively infinity
(setf lim 10000.0)))
(display "compress-map"
m s ; see equations above
eupd ; et1 + d
cupd ; ct1 + d
lim ; 0dB or infinity, depends on limit
b2 ; y-intercept of the 1:1 part
ea eb ec ca cb cc ; polynomial coefficients
eu ev cu cv ; intersection points (u,v)
ed cd) ; d values
; now create function that goes 100dB below expansion threshold
; and up to 100dB
(setf lower-db -100.0)
(setf upper-db 100.0)
(setf map (make-array 201))
(setf x lower-db) ; this should be an even integer
(dotimes (i (length map))
(setf (aref map i)
(cond ((< x eu) (+ ev (* s (- x eu))))
((< x eupd) (+ ea (* eb x) (* ec x x)))
((< x cu) (+ cv (- x cu)))
((< x cupd) (+ ca (* cb x) (* cc x x)))
((< x lim) (* m x))
(t 0)))
; map[i] has the desired output dB, so subtract input dB to
; get gain:
(setf (aref map i) (- (aref map i) x))
(cond ((and (> x (- eu 3)) (< x 0))
(format t "~A -> ~A~%" x (aref map i))))
(setf x (+ x 1)))
; return a sound
(snd-from-array 0.0 100.0 map)))
(defun db-average (input)
(let (y)
(setf y (mult input input)) ; first square input
(setf y (snd-avg y 1000 500)) ; then time average
(setf y (snd-log (scale 2.0 y))) ; peak normalization, then take log
(setf y (scale (/ 10.0 (log 10.0)) y)) ; see below for scaling explanation
y))
(defun compress (input map rise-time fall-time &optional (lookahead 0.0))
; take the square of the input to get power
(let ((in-squared (mult input input))
window avg env gain)
(cond ((zerop lookahead) (setf lookahead rise-time)))
; compute the time-average (sort of a low-pass) of the square
; parameters give 50ms window and a 25ms step
(setf window (round (* (snd-srate input) 0.05)))
(setf avg (snd-avg in-squared window (/ window 2) op-average))
; use follower to anticipate rise and trail off smoothly
; N.B.: the floor (2nd argument to snd-follow) should be the
; square of the noise floor, e.g. for a noise floor of 1/2^16,
; use 1/2^32 = about 4E-9. If the number is too small, you will
; not get expansion below the square root of the floor parameter.
; set lookahead to be number of samples in rise time:
(setf lookahead (round (* lookahead (snd-srate avg))))
(setf env (snd-follow avg 0.000001 rise-time fall-time lookahead))
; take logarithm to get dB instead of linear, also adjust for
; peak vs. average as follows: a sinusoid with peak of 1.0 has
; an average amplitude of 1/sqrt(2), we squared the signal, so
; the average amplitude should be 1/2, so multiply by 2 so
; that a sine with peak amplitude of 1 will get an average of 1
; which will convert to 0dB
(setf logenv (snd-log (scale 2.0 env)))
; tricky part: map converts dB of input to desired gain in dB
; this defines the character of the compressor
; map is scaled so that (0,2) corresponds to (-100dB, 100dB)
; so you need to scale input by .01. But first, we need to get dB:
; we have log(avg(x^2)), and we want dB = 20log10(sqrt(avg(x^2)))
; simplify dB to 10log10(avg(x^2)) = 10log(avg(x^2))/log(10),
; so scale by 10/log(10) * 0.01 = 0.1/log(10)
(setf shaped-env (shape (setf gle (scale (/ 0.1 (log 10.0)) logenv)) map 1.0))
; Go back to linear. To get from dB to linear, use:
; 20log(linear) = dB
; linear = exp(dB/20),
; so scale the result by 1/20 = 0.05
(setf gain (snd-exp (scale 0.05 shaped-env)))
; return the scaled input sound,
; another trick: avg signal will be delayed. Also, snd-follow
; has a delayed response because it's looking ahead in sound
; 20 = the number of samples of lookahead from snd-follow
; 88.2 = 44,100 (sample rate) / 500 (the step-size in avg)
; in other words, 44100/500 is the sample rate of the control
; signal looked at by follow
; "44100" should be replaced by the signal's sample rate
; = (snd-srate input)
; (setf gg gain)
(sound-srate-abs (snd-srate input) ; set default sample rate for s-rest
(mult (seq (s-rest (/ 20.0 (/ (snd-srate input) 500.0))) (cue input)) gain))))
; this is an automatic gain control using peak detection for
; gain control -- the range parameter gives the maximum gain in dB
; the agc will attenuate peaks to 1.0.
;
(defun agc (input range rise-time fall-time &optional (lookahead 0.0))
; take the square of the input to get power
(let (window avg env gain lookahead-samples)
(cond ((zerop lookahead) (setf lookahead rise-time)))
; compute the time-average (sort of a low-pass) of the square
; parameters give 50ms window and a 25ms step
(setf window (round (* (snd-srate input) 0.05)))
(setf avg (snd-avg input window (/ window 2) op-peak))
; use follower to anticipate rise and trail off smoothly
; set lookahead to be number of samples in rise time:
(setf lookahead-samples (round (* lookahead (snd-srate avg))))
(setf env (snd-follow avg (db-to-linear (- range))
rise-time fall-time lookahead-samples))
(setf gain (snd-recip env))
; return the scaled input sound,
; another trick: avg signal will be delayed. Also, snd-follow
; has a delayed response because it's looking ahead in sound
; 20 = the number of samples of lookahead from snd-follow
; 88.2 = 44,100 (sample rate) / 500 (the step-size in avg)
; in other words, 44100/500 is the sample rate of the control
; signal looked at by follow
(sound-srate-abs (snd-srate input) ; set default sample rate for s-rest
(mult (seq (s-rest lookahead) (cue input)) gain))
;(vector ; (seq (s-rest lookahead) (cue input))
; (mult (seq (s-rest lookahead) (cue input)) gain)
; (force-srate (snd-srate input) (scale 0.3 gain))))
))
Simple Compressor Example /
Speech Compressor Example
Audacity Support Forum /
Audacity and Nyquist /
Nyquist Reference Manual /
Nyquist Examples and Tutorials