The Sound of the Big Bang

A simulation of the sound frequencies present in the early

universe, based on data from WMAP measurements of

Cosmic Background Radiation small-angle structure.

John G. Cramer
Professor of Physics
University of Washington
Seattle, WA 98195-1560

cramer@phys.washington.edu
November 4, 2003

Setup

Clear["Global`*"];
Off[General::spell];
Off[General::spell1];

Define path to input and output files 
(This statement is system-dependent and should be modified for 
your system.)

fil0 = "F:\Mma\BigBangSound";

Set the frequency scale factor (1.5).
(This sets the pitch of the overall sound and is chosen "by 
ear";
fPk=1.5 means that a Cosmic Background Radiation frequency of L=1 
produces a sound
frequency 1.5 Hz at the peak of CBR emission )

fPk = 1.5;

Set the duration for sound file (100 sec).  The value will be included in the 
output file name.

dur = 100;

d2 = dur/2;

duSt = ToString[dur];

ffac = fPk*d2^(2/3);

Set peak time of Cosmic Background Radiation emission (379 thousand years).

cbrPk = 379;

Set sigma of Cosmic Background Radiation emission (118 thousand years).

Sigma is the time required for emission to fall to (e^(-1/2)) = 60.7% of peak value.

cbrSg = 118;

Simulation

Read in WMAP Data

Temp = 

        ReadList[fil0 <> "\WMAPdata.txt", Number, 

          RecordLists -> True];

lenT = Length[Temp]

Plot WMAP Data

\(\(ListPlot[Table[{Temp[\([j, 1]\)], Temp[\([j, 2]\)]}, {j, lenT}], 

        Frame -> True, 

        FrameLabel -> {"L", "Amplitude", "WMAP Data", 
""}, ImageSize -> 600];\)\)

Define Big Bang Sound Function

First line is a Gaussian profile of sound intensity;
\(Second\ line\ is\ an\ intensity\ adjustment\ for\ height\ 
×\ histogram\ width\ of\ each\ frequency;\)
Third line is frequency,  

      using cosines that start with maximum at t = 0 and are
Doppler-shifted by (t^(-2/3)), so that the net time dependence goes like (t^(1/3)).

BBSnd[t_] = 

      Exp[-((t - d2)/(cbrSg*d2/cbrPk))^2 /2]*

        Sum[(((Temp[[j, 1]] - Temp[[j - 1, 1]])/

                    Temp[[j, 1]])*Temp[[j, 2]])*

            Cos[ffac*2  π*Temp[[j, 1]]*t^(1/3)], {j, 2, 

            lenT}]

Output

Plot Sound Function

Plot[BBSnd[t], {t, 0, dur}, Frame -> True, 

        FrameLabel -> {"Time", "Amplitude", "Sound \

Function", ""}, PlotRange -> All, 

        ImageSize -> 600];

Play Sound Function  (This requires some CPU time, particularly for large dur values.  Be patient.)

BBs = 

        Play[BBSnd[t], {t, 0, dur}, PlayRange -> All];

Record Sound Function on hard disk as .wav file

Export[fil0 <> "\BBSnd" <> duSt <> ".wav", 

      BBs, "WAV"]