Multichannel Intensity Panning

Below is a rather complex, not so elementary example. It has to do with spatialization of sound sources. Here we are posting code mainly for legacy and historical reasons, in addition to outlining more features of Snd's s7. Complexity gives flexibility at the expense of a rather not so steep (hopefully) slope. With some time and insight a great deal can be learned from all programming shown here. If there is some intimidation, reader should feel free not to tackle this subject and implementation now, on the hope of coming back later.

On this web page, we are presenting an instance of a theory and its applications using a computer model. Though it should be acknowledged that a complete discussion of this subject matter is well beyond the scope of these introductory pages. Here we are presenting elementary concepts pertaining to spatialization and motion of a sound source, given a path in a two-dimensional plane with expectations that readers can build upon, and extend its use. Hopefully to go deeper on now accessible sound diffusion techniques such as Ambisonics, VBAP, and perhaps wave field synthesis. On understanding code here, reader would at least get some curiosity on topics as follows: spatial perception of sound, intensity panning, Doppler Effect, motion of sound sources, reverberation, Lissajous Figures, and localization of sources as well as structure and functional programming using Scheme.

Using Lissajous Figures in a musical context is a technique pursued by John Chowning and others on the days of SAIL, Stanford Artificial Intelligence Laboratory. A complete recount of this research is on a Computer Music Journal paper titled “The Simulation of Moving Sources” published by John Chowning. It is advisable for readers interested on this subject to get their hands on this paper. Insight on Turenas, among pioneering Computer Music pieces is also recommended. Although widely available as a stereo recording, multichannel renditions can also be obtained. Most certainly by listening to this piece people get acquainted with the nature of acoustical space manipulation.

Code below makes use of J. Chowning's Lissajous equations, but this time using a white noise sound source so the effect is better perceived. Doppler is added so that a person in a sweet spot listens to sounds coming-and-going. Keep on mind that Doppler is function of distance, as well as speed of source which is also dependent on time. Reverberation is also an intricate part thereby giving the illusion of an enclosed space as a listening environment. More on the subject is widely available on publications all around. There is even a Stanford course on the subject of “Sound in Space”taught by Fernando Lopez-Lezcano who has been researching the subject for years now. Among other people contributing deeply to the field worth mentioning are Dick Moore, Gary Kendall, Pablo di Liscia, Juan Pampin, Joe Anderson, Pablo Cetta, just to name a few. Before getting into the code, a bit of theory as outlined on Dick Moores's book “Elements of Computer Music” might prove helpful for better understanding these processes. Seems worth to remark that code for below application of intensity panning using J. Chowning's Lissajous functions was based on Dick Moore's CMusic panning unit generator written in “C” language.

“In the production of computer music, the typical problem is not to simulate a particular concert hall or room with any precision but to impart a spatial quality to sounds generated either by modification of recorded sounds or by methods of pure synthesis.”

Dick Moore's quote above outlines “spatial quality” to perception of sounds. This can also be portrayed as sound coming from everywhere on three dimensions. On this portrait localization of sounds becomes a composition parameter. For this it is necessary to consider the processing of signals both by digital signal processing(dsp) and by our own hearing mechanism. Paraphrasing Moore again, we define the quest for sound spatialization in various ways:

The problem of sound spatialization is then the problem of gaining prescriptive control over positions of virtual sound sources within an imaginary, virtual, or illusory space in which such events may occur. For this we need to keep in mind that:

In regards to intensity it should be said that sounds in the real world coming from directly in front of, or behind the listener, reach both ears with equal intensity, while those coming from the right or left reach one ear with slightly more intensity than the other. A general impression of directional intensity may be simulated through the use of “intensity panning”. While using a multichannel speaker system, we can provide ideal intensity cues only for directions defined by positions of the speakers. At azimuth angles intermediate between any two of these directions, we can distribute sound between adjacent pairs of loudspeakers.

Generally, we can control the intensity of a sound in each playback channel by using a gain factor that is multiplied directly to the waveform of the sound undergoing spatialization. Because such a gain factor multiplies the waveform directly, it represents a direct control on the amplitude rather than its intensity. Recall that intensity is also a function of distance. Thus intensity changes with distance following the inverse square law of intensities, where sound is inversely proportional to the square of its distance from the source to the listener.. Therefore amplitude is proportional to the square root intensity for linear amplitudes.

To maintain a constant sound intensity at the listener's position for all intermediate positions of the virtual sound source as it pans from left to right, we require that the total intensity be constant. On mathematical terms we can think of a relation like $g_1^2+g_2^2=K$, where'g' and 'h' are the respective gains of each speaker and where 'K' is a constant. If we take look at, $sin^2(\theta)+cos^2(\theta)=1$, we see that the squares of sine and cosine are equal to 'one' which is always constant.

Therefore by using this relation, we can always guarantee that at every angle theta with the azimuth of a sound source, sum of its squares will always be one and a constant. But keep on mind that intensity proportional to the inverse square of distance. In order to create a realistic illusion while using intensity panning we need to add the distance component. Distance here is the distance between the listener and the loudspeaker. For a realistic pan we need to use the following equations:

$\displaystyle g_1=\frac{\sin^2(\theta)}{d^2} $

$\displaystyle g_2=\frac{\cos^2(\theta)}{d^2} $

where 'g' is gain factor of each loudspeaker, theta azimuth angle and'd' is distance. A physicist description of intensity outlines:

Energy from the motion of sound waves flows through the eardrums and into the inner ear where is registered as sound. Intensity 'I' is the energy 'E' per unit of time 't' that is flowing across a surface of a unit area 'a'. Therefore $I=P/a^2 $, where $P=E/t $. Power for this purpose is equivalent to the amplitude of a sound.

For a circular pan without a hole in the middle we can use the following equations:

$\displaystyle g_a=\frac{\sqrt(2)}{2}[cos(\theta)+sin(\theta)] $

$\displaystyle g_b=\frac{\sqrt(2)}{2}[cos(\theta)-sin(\theta)] $

Now above equations need to be implemented. For this purpose a stereo panning program needs to coded. Below is our first elementary “stereo” intensity panning program. Only hack here is that we need to adjust angular phase starting on pi/4 so that sound starts moving from one loudspeaker to the other. A constant called 'cfactor' stores the value of square root of two over two, which is also equal to sin(pi/4) and cos(pi/4). Program is commented to help understanding what is going on.


 		 
(define* (pan-equal beg dur freq amp dist
		    (cycles 1)   ;; number of rounds
		    (dir #t))    ;; direction of rounds
  
  (let* ((start (seconds->samples beg))	
	 (s (make-oscil :frequency freq))
	 (zeta (/ pi 4))
	 (theta 0.)
	 (cfactor (cos (/ pi 4)))
	 (end (seconds->samples (+ beg dur)))		
	 )

    ;; Check for direction parameters clockwise start on -pi
    ;;                        counter-clockwise start on +pi

    (if dir (set! theta (- zeta))
	(set! theta zeta))

    ;; main loop
    ;;
    
    (do ((i start (1+ i)))
	((= i end))
      (let* ((gfa (* cfactor (+ (cos theta) (sin theta))))
	     (gfb (* cfactor (- (cos theta) (sin theta)))) 
	     (invsq (* (/ (* dist dist)) amp))
	     (amp1 (* gfa invsq))
	     (amp2 (* gfb invsq))
	     (signal (oscil s))
	     )
      	(outa i (* amp1 signal))
	(outb i (* amp2 signal))

	;; update azimuth angle values
					;
	(if dir
	    (begin
	      (set! theta (+ theta (/ (* cycles pi) end)))
	      (if (>= theta  (* 7 zeta)) (set! theta (- zeta))) )
	    (begin
	      (set! theta (- theta (/ (* cycles pi) end)))
	      (if (<= theta  (- (* 7 zeta))) (set! theta zeta)) )
	    )
	))
    ))

Above program pans a simple sine wave into two “Stereo” channels. Here we are adding useful features which make it longer but they add more flexibility. Instead of going from left to right, we can make sound go around several times by toggling 'cycles' parameter. A value of two is two complete rounds. A value of four is four rounds. Likewise a direction parameter can also be toggled. Notice that equations are implemented inside the main loop. Azimuth is incremented on a sample rate level so that signal smoothly goes from one channel to the other. Keep on mind that angular phase here is changing as time goes by.


snd-stereo.png

On the image above a sound file with two channels can be seen. Notice that phase on each channel is different. This means that the intensity one channel is different from the other but if you add them together at every point, they add up to a constant, here the absolute value of one |1|. Following a perception standpoint, a sound can be heard first coming from side and then going to the other. Because of inverse square relationship, this effect seems like circular motion illusion. Here a sound can be heard making a round or perhaps several rounds.


Listen carefully to the sound generated in two channels and try to perceive its motion from one side to the other. Here we are creating the illusion of an imaginary space beyond loudspeakers and circular motion on headphones. Change parameters on function calls to hear different parameters. Further try to hack the above code so that sound is something different than pure sine wave. May be try to read a mono sound file and pan it around. Above code is basic and a stepping stone for our next multichannel sound diffusion application. Not that we are hoping that by hacking above code you will end up with next example. But perhaps curiosity might lead you to something close. Question might be then, what about more than two-channels stereo?.


LISSAJOUS FIGURES
———————————————————-
Lissajous Figures, familiar to most physical scientists and engineers, connotes harmony, order and stability. Lissajous figures are named after French mathematician Jules Antoine Lissajous, but are also known as Bowditch curves after Nathaniel Bowditch, a mathematician from Salem, Massachusetts, who discovered them around 1815.Lissajous figures were sometimes displayed on oscilloscopes meant to simulate high-tech equipment in science-fiction TV shows and movies in the 1960s and 1970s. Lissajous curves are the family of curves described by the parametric equations:

$\displaystyle x(t) = asin(\omega_xt-\delta_x) $

$\displaystyle y(t) = bsin(t) $

With these equations we get x/y pairs that plot on rectangular coordinates producing curves depending on parameters for factors and angles of the above equations. MatLab or Octave for that matter are very useful for plotting Lissajous Curve. See here.

- But, what about these figures?.- John Chowning had been experimenting with drawing tools on early computer devices to get points for creating motion of sound using azimuth and Doppler shift parameters. Motion of the source from one point to other will be give a difference in location. By using a mouse-like device he was able to control points that generated graphic output though no sound. In this way there was not near actual interaction with sound and therefore mapping parameter from graphs to composition tended to be a cumbersome method. But because of being in a laboratory environment such at SAIL, David Poole, another researcher at the time, pointed out that these drawing patterns looked like a Lissajous figure. Then curiosity was sparked by his comment leading Chowning to learn about and program Lissajous figures.

“I quickly advanced through the well-known looping patterns and discovered that interesting figures could be generated, and whose sound manifestation possessed a graceful motion that seemed to me natural —as the sound followed the path of a Lissajous figure it decelerated and accelerated as it approached and left a change in direction.”

In regards to Turenas and spatial motion of sound sources Chowning goes further on Lissajous figures:

“In Turenas I made full use of the newly acquired control of sounds in space. The spatial trajectories areboth curvilinear and linear motions. The linear trajectories are sometimes expressedby radical changes in timbre as the sounds pass through the listener space. Thus, computer synthesis allowed me to achieve synchronous control over spatial trajectories and timbral transformations.”


Here are John Chowning's Lissajous equation having sine and cosine components:

$\displaystyle y_\tau = cos(3\pi\tau) + cos(7\pi\tau) $

$\displaystyle x_\tau = sin(2\pi\tau) + sin(6\pi\tau) $

Below is a graph of these Lissajous Equations on the x/y plane:

lissajous-img.png

Interestingly enough this image shows four corners, each one more or less at 45 deg. where loudspeakers on a four channel two-dimensional system are located. We can see that traces here, outline sound paths from one quadrant to the other or even from the center outwards, and so forth. For J. Chowning a diameter, if we could draw a circumference, was well beyond 10 mts. on an illusory space beyond ithe inward space from the listener and the four loudspeaker. Therefore there are paths which are longer than others thus consequently changing time and speed of sound source accordingly. Intensity gain or panning on this four sided spaces changes with traces outline on this Lissajous figure. With other localization cues such as Doppler and reverberation listeners would perceive sounds comin and going, from one side to the other.


Coming back to the question posted before as how we go from two-channel “stereo” to four-channel and perhaps beyond, it is important to keep on mind that listening space is 360 deg. and that any sound source will come somewhere around this circle. To cue an angular position an energy ratio (gain or attenuation) is applied to the direct signal on each loudspeaker pair. Since we have four quadrants, angles between loudspeaker pairs are 90 deg. in relation to the listener. The obvious means of changing ratio of the direct signal for the moving source, is to make the energy applied to the loudspeakers pairs proportional to the angle of displacement. Very much like we did on the two channel example but after calculations for channel-one and channel-two, we calculate energy ratios for channel-two and channel-three, and so forth. For this purpose we need to come up with a function tha helps to find out energy ratios for each of the four loudspeaker. We can start with th following equation as stated on by Dick Moore on Elements of Computer music:

$\displaystyle G_n(\theta) = \left\{\begin{array}{cc}
\cos(\theta-\theta_n) & \...
...theta-\theta_n\vert <
90^\circ \\
0 & \text{otherwise.}
\end{array}\right. $

Above Gn is gain-of-speaker-n, theta is position of sound source and theta-n is angle of loudspeaker-n. This function is implemented on s7 scheme as follows:


 		 
(define halfpi (* 2. (atan 1.)))

(define (posi rho spkpos distf)
  (let* ((diff (- rho spkpos))
	 (in-between-angle halfpi))
    (if (>= (abs diff) in-between-angle)
	(values 0)  (* (cos diff) distf))
    ))

Function above takes the angle where the sound source is, the angle of the standing speaker in addition to the inverse square of distance. From our main program we will call this function to calculate gain for each speaker depending upon position. Note that above function gives gains for positions in between loudspeakers. Recall that gain is proportional to distance, therefore gain here is among localization cues.

Furthermore, in order to simulate the distance cue, a reverberant signal should be synthesized in addition to a direct signal (as above), such that the intensity of the direct signal decreases more with distance than does the reverb signal. Thus, as more distance from the listener, overall gain or amplitude is attenuated. It is assumed that in a small space, the amplitude of reverb signal produced by the sound source at constant intensity but varying distances from the listener changes little, but in a large space it changes somewhat.


As for motion or sound source and velocity cues, we know that a static listener receives velocity information from a moving sound source at a rate of change proportional to speed. Similarly a frequency shift can also tell if source is getting closer or getting away. This because of Doppler shifts better known as Doppler Effect. The simulation of the Doppler effect is achieved, simply, by scaling the unit of distance in meters and making change in frequency proportional to the rate of change of distance over time. Our implementation of Doppler shifts is done by using delay lines. We get frequency changes by changing the length of a delay line. There is a delay line for each loudspeaker. Length is calculated from the distance of the sound source to the listener.

As pointed before reverberation is also an essential part of the distance cue. Perceived reverberation also gives size of room and space information, including shape. Plainly speaking reverberation, might be defined as the persistence of sound after its excitation. Quantitatively is regarded as the collection of reflected sounds from the surfaces in an enclosed space such like an auditorium. Direct sound received is followed by distinct early reflected sounds and then a collection of many tail reflected sounds which blend and overlap giving characteristics of an auditorium or even virtual space. John Chowning again points out: “ In simulating a sound source in an enclosed space, then, it is desirable for the artificial reverberation to surround the listener and to be spatially diffuse.”

Below is our intensity panning program written on Snd's s7. In addition to Lissajous Figures as a basis for spatial gestures, this code implements above and just described features for obtaining cues for localizing a sound around a space. It is assumed that listener is on the center (sweet spot) and surrounded by a set of loudspeakers, each at a fixed distance from the listening spot. It is important to point out that position of sound source changes with time and depends on angular position inside a 360-deg. circle. Sound-path gestures are performed beyond the perimeter outlined by loudspeakers on a bigger illusory space behind. Note that Lissajous image above shows several cycles (iterations) of Lissajous equations. In order to achieve full gestures we don't need complete iterations of the equations.


 		 
(define twopi (* 8. (atan 1.)))
(define halfpi (* 2. (atan 1.)))


(define samprate (seconds->samples 1))

(define sspeed 343)

(define (distn->samples dist)
  (floor (* dist (/ samprate sspeed)))
  )

(define nchans 4)


;;
;; ;;  
;; ;;  Gain at position: quadrant in reference to speaker.
;;

(define (gainfn rho spkpos distf nchs)
  (let* ((diff (- spkpos rho))
	 (in-between-angle (/ twopi nchs))
	 )
    (if (>= (abs diff) in-between-angle)
	(values 0)  (* (cos diff) distf))
    ))

;;
;; ;;  A moving sound source function definition.
;; ;;  ===========================================
;;

(define* (lissajous beg dur (frq 800) (cycles 1) (nch nchans) (rev-amt 0.025))
  (let* ((start (seconds->samples beg))
	 (flt (make-two-pole :radius .998 :frequency frq))
	 (ran1 (make-rand  8000 0.00750))                 ;; get some noise
	 (zeta (* cycles halfpi))                      ;; start angular position
	 (theta zeta)                                  ;; position in time
	 (dsize (distn->samples 10))                    ;; 2.0 Min distn
	 (maxdllsz (distn->samples 1000))                ;; Max delay (distn)
	 (dll (make-delay dsize :max-size maxdllsz))    ;; delay line 
	 (speaker (make-vector nch))                   ;; speaker position array 
	 (gains (make-vector nch))                     ;; gains array
	 (outsig (make-vector nch))                    ;; final signals
	 (end (+ start (seconds->samples dur))))

					;
					; Initialize speaker positions
					; degrees: -45; 45; 135; -135;
					;
    
    (do ((k 0 (1+ k)))
	((= k nch ))
      (let ((rads (+ (/ pi nch) (* k (/ twopi nch))))
	    (idx (- (1- nch) (modulo (1+ k) nch))))
	(set! (speaker idx) (- pi rads))
	))

    
    ;;
    ;; ; main " generate signal" loop
    ;; ; ----------------------------
    ;;
    
    (do ((i start (1+ i))) 
	((= i end))
      ;;
      (let* ((insig (rand ran1))                    ;; noise unit generator
	     ;;
					; J. Chowning Lissajous equations
	     ;;
	     (yt (+ (cos (* 3 pi theta)) (cos (* 7 pi theta))))  
	     (xt (+ (sin (* 2 pi theta)) (cos (* 6 pi theta))))
	     ;;
					; New position angle (polar coordinates) 
	     ;;
	     (rho (atan yt xt))
	     ;;
					; distance of sound source from origin
	     ;;
	     (dfn0 (sqrt (+ (* xt xt) (* yt yt))))

					;
					; distance cannot be zero
					; becasue we get infinite 
					; gain (signal blows)
					;
	     
	     (distn (+ dfn0 1.998))
	     ;;
					; inverse squared distance
	     (invsqd (/ (* distn distn)))
	     
					; change filter center freq
	     
	     (cfq (+ (- frq 50) (* 256 (/ (1+ dfn0)))))
	     
					; two-pole filter

	     (noi (two-pole flt insig))

	     )
	;;
	;;
					; change filter center freq
	(set! (mus-frequency flt) cfq)
	
	;;
	;; ;;  calculate gain for each speaker
	;;
	
	(do ((j 0 (1+ j)))
	    ((= j nch))
	  (let ((gf (gainfn rho (speaker j) invsqd nch)))
	    (set! (gains j) (* gf 5.998)) ))
	
	;;
	;; ;;  Generate Doppler motion plus output signal
	;; ;;  ------------------------------------------
	;;
	
	(do ((j 0 (1+ j)))
	    ((= j nch))
	  (let ((gfn (gains j)))
	    (set! (outsig j) (* gfn
				(+ (* .075 noi)
				   (* .375 (delay dll noi
					     (* 4747 (/ (1+ dfn0))))
				 )))
		)))
	;;
	;; ;; --> Here we start output
	;;
	
	(do ((k 0 (1+ k)))
	    ((= k nch))
	  (out-any i (* .625 (outsig k)) k)

	  ;;
	  ;; ;; add reverb!
	  ;;
	  
	  (if *reverb*
	      (let ((dist-scaler (* 2.725 invsqd))
		    )
		(out-any i (* (outsig k)
			      (*  rev-amt  dist-scaler))
			 k *reverb*) ) )
	  )
	
	;;
	;; ;; Increment grow angle function
	;; ;; -----------------------------
	;;
	
      	(set! theta (- theta (/ (* .25 cycles pi) end)))
	(if (< theta  (- zeta)) (set! theta zeta)) ))  ))


;;
;; ;;           - E N D -
;; ;; -----------------------------
;;


Listen carefully to the sound generated in four channels and try to perceive its motion on the listening space. Here, there is the illusion of an imaginary space beyond loudspeakers. Change parameters on function calls to hear different parameters. Furthermore, hack the above code so that sound is something different than just whistling noise. Read a mono sound file and diffuse it everywhere. But think spatialization and why does it need to fit in a particular composition.


© Copyright 2001-2022 CCRMA, Stanford University. All rights reserved.
Created and Mantained by Juan Reyes