Generating Shepard and Risset tones

Question

The Shepard tone is a famous auditory illusion where the successively generated tones seem as if they keep going higher and higher in pitch. The Risset glissando is a similar auditory illusion, but is the continuous analog. I would like to know how to generate these in Mathematica please.

Some research I have done says that there is an implementation of the Shepard tone in the book Exploring Mathematics with Mathematica, but I have been unsuccessful in locating this code. How can I use Sound or Play to generate the Shepard and Risset tones?

Answer 1

to generate middle c..

you make the air vibrate 262 times in 1 second

If you give mathematica a Sine wave that repeats 262 times a second it will convert this to sound wave.

For a Sine function to go up and down it has to be given a length of the Real number line 2$\pi$ units long which is from 0 to about 6.

If you multiply this interval by 262 the Sine wave will go through its cycle 262 times in 1 unit of number line.

To hear it you replace the Plot with Play

Play[Sin[262 2 \[Pi] t], {t, 0, 1}]

To hear the first Shepard tone you multiply the Sine's argument (currently $262*2\pi$) by $2^{\frac{1}{12}}$ and then you add four of these Sine functions together to represent adjacent octaves.

$$\sin\left({262*2 \pi* 2^\frac{1}{12}}\right)$$

$$\sin\left({2*262*2 \pi* 2^\frac{1}{12}}\right)+ \sin\left({4*262*2 \pi* 2^\frac{1}{12}}\right)+ \sin\left({8*262*2 \pi* 2^\frac{1}{12}}\right)+ \sin\left({16*262*2 \pi* 2^\frac{1}{12}}\right)$$

Play[
  Sin[2^(1/12)* 263*2 \[Pi]* 1/2 t] + 
  Sin[2^(1/12)* 263*2 \[Pi]* 1/4 t] +
  Sin[2^(1/12)* 263*2 \[Pi]* 1/8 t] +
  Sin[2^(1/12)* 263*2 \[Pi]* 1/16 t], 
{t, 0, 1}]

To hear the second Shepard tone

Play[
 Sin[2^(2/12)* 263*2 \[Pi]* 1/2 t] + 
 Sin[2^(2/12)* 263*2 \[Pi]* 1/4 t] +
 Sin[2^(2/12)* 263*2 \[Pi]* 1/8 t] +
 Sin[2^(2/12)* 263*2 \[Pi]* 1/16 t],

 {t, 0, 1}]

To hear the third Shepard tone

 Play[
  Sin[2^(3/12)* 263*2 \[Pi]* 1/2 t] + 
  Sin[2^(3/12)* 263*2 \[Pi]* 1/4 t] +
  Sin[2^(3/12)* 263*2 \[Pi]* 1/8 t] +
  Sin[2^(3/12)* 263*2 \[Pi]* 1/16 t],
{t, 0, 1}]

notice that the scale is achieved by incrementing the $\frac{1}{12}$ by twelfths.

To hear them all:

Manipulate[
  Play[
    Sin[2^(m/12)*263*2 \[Pi]*1/2 t] + 
    Sin[2^(m/12)*263*2 \[Pi]*1/4 t] + 
    Sin[2^(m/12)*263*2 \[Pi]*1/8 t] +
    Sin[2^(m/12)*263*2 \[Pi]*1/16 t],
  {t, 0, 1}],
{m, 1, 11, 1}]

first attempt at the glissando

f[m_] := Sin[263 2^(-3 + m/12) \[Pi] t] + 
         Sin[263 2^(-2 + m/12) \[Pi] t] + 
         Sin[263 2^(-1 + m/12) \[Pi] t] + 
         Sin[263 2^(m/12) \[Pi] t]

Play[Piecewise[
  Evaluate[Flatten /@ 
   Table[{{Evaluate[f[1 + .1 i]], 0 + .1 i < t < .1 + .1 i}}, {i, 1, 
     1000}]]],
    {t, 0, 11}]

---

Theodore Gray's harmonic wizardry

 harmonicAmplitude[f_] := N[1 - Cos[(2 \[Pi] Log[f/263])/Log[2^5]]];

>

envelope[t_, duration_] := (Log[t + 0.001] - Log[0.001]) E^(-4/duration t);

>

tone[t_, m_, duration_] :=

N[
 envelope[t, duration]* Total[
  Table[
   Sin[2.^m 263 2.^n t] 
    harmonicAmplitude[2.^m 263 2.^n],
  {n, 0, 4}]]];

>

Table[
 Play[
  Evaluate[
   tone[t, m/12, 1]
  ],
 {t, 0, 1}, PlayRange -> {-9, 9}],

{m, 0, 11}]

the whole shebang

Clear[harmonicAmplitude, envelope, tone];

harmonicAmplitude[f_] := N[1 - Cos[(2 \[Pi] Log[f/263])/Log[2^5]]];

envelope[t_, duration_] := (Log[t + 0.001] - Log[0.001]) E^(-4/duration t);


tone[t_, m_, duration_] := 
N[envelope[t, duration]* 
Total[Table[
  Sin[2.^m 263 2.^n t] harmonicAmplitude[2.^m 263 2.^n], {n, 0, 
   4}]]];

Manipulate[Graphics[{
Inset[Style["Click the buttons.", "Label", 14], {0, .5}], 
Inset[Style["Which gives the highest tone?", "Label", 14], {0, 0}],
 Inset[Style["They don't change.", "Label", 14], {0, -0.5}],
Table[Inset[
  With[{snd = 
      Play[Evaluate[tone[t, m/12, duration]], {t, 0, duration}, 
      PlayRange -> {-9, 9}]}, 
   Button["", EmitSound[snd], ImageSize -> {50, 50}, 
   Background -> 
    If[m === highlight, RGBColor[1, .47, 0], 
     Automatic]]], {Cos[-2 Pi m/12 + Pi/4 + Pi/12], 
    Sin[-2 Pi m/12 + Pi/4 + Pi/12]}], {m, 0, 11}]}, 
   ImageSize -> {500, 400}],
  {{duration, .8}, 0.1, 5},
 {{highlight, 12}, 0, 12, 1, ControlType -> None}, 
  SaveDefinitions -> True]

Answer 2

Slightly simpler code, which some procs for playing sequences or chords:

harmonicAmplitude[f_] := N[1 - Cos[(2 \[Pi] Log[f/263])/Log[2^5]]];
envelope[t_, 
   duration_] := (Log[t + 0.001] - Log[0.001]) E^(-4/duration t);

tone[t_, m_, duration_] := 
  N[envelope[t, duration]* 
    Total[Table[
      Sin[2.^m 263 2.^n t] harmonicAmplitude[2.^m 263 2.^n], {n, 0, 
       4}]]];

joueGamme[gamme_, duration_: 0.35] :=

 Sound[Map[
   Play[Evaluate[tone[t, #, 2*duration]], {t, 0, duration}, 
     PlayRange -> {-25, 25}] &,
   gamme]]

joueQuintes[gamme_, duration_: 0.4] :=

 EmitSound[
  Table[Play[
    tone[t, gamme[[k]], 2*duration] + 
     tone[t, gamme[[Mod[k + 6, 12] + 1]], 2*duration], 
            {t, 0, duration}, PlayRange -> {-9, 9}],
    {k, 12}] ]

joueGammeMajeure[gamme_, tonalité_, duration_: 0.4] :=

 Sound[Map[
   Play[Evaluate[tone[t, #, 2*duration]], {t, 0, duration}, 
     PlayRange -> {-9, 9}] &,
   Part[gamme, 
    Mod[{0, 2, 4, 5, 7, 9, 11, 12} + tonalité - 1, 12] + 1]]]

joueTriades[g_, d_: 0.8] := Sound[{
   Sound[joueGamme[g, d],                                      {d, 
     13 d}], 
   Sound[joueGamme[RotateRight[g, 4], d], {d, 13 d}],
   Sound[joueGamme[RotateRight[g, 7], d], {d, 13 d}]}]