(************** Content-type: application/mathematica **************
                     CreatedBy='Mathematica 5.0'

                    Mathematica-Compatible Notebook

This notebook can be used with any Mathematica-compatible
application, such as Mathematica, MathReader or Publicon. The data
for the notebook starts with the line containing stars above.

To get the notebook into a Mathematica-compatible application, do
one of the following:

* Save the data starting with the line of stars above into a file
  with a name ending in .nb, then open the file inside the
  application;

* Copy the data starting with the line of stars above to the
  clipboard, then use the Paste menu command inside the application.

Data for notebooks contains only printable 7-bit ASCII and can be
sent directly in email or through ftp in text mode.  Newlines can be
CR, LF or CRLF (Unix, Macintosh or MS-DOS style).

NOTE: If you modify the data for this notebook not in a Mathematica-
compatible application, you must delete the line below containing
the word CacheID, otherwise Mathematica-compatible applications may
try to use invalid cache data.

For more information on notebooks and Mathematica-compatible 
applications, contact Wolfram Research:
  web: http://www.wolfram.com
  email: info@wolfram.com
  phone: +1-217-398-0700 (U.S.)

Notebook reader applications are available free of charge from 
Wolfram Research.
*******************************************************************)

(*CacheID: 232*)


(*NotebookFileLineBreakTest
NotebookFileLineBreakTest*)
(*NotebookOptionsPosition[     26045,        830]*)
(*NotebookOutlinePosition[     26722,        853]*)
(*  CellTagsIndexPosition[     26678,        849]*)
(*WindowFrame->Normal*)



Notebook[{

Cell[CellGroupData[{
Cell["Wavelets and Applications", "Title"],

Cell["The Discrete Haar Wavelet Transform", "Subtitle"],

Cell[CellGroupData[{

Cell["Abstract", "Section"],

Cell["\<\
At the end of this computer project, you should have a working version of the \
Discrete Haar Wavelet Transform (DHWT) and its inverse.  Your routine will \
take as input a vector and the number of iterations and return the \
transformed vector.\
\>", "Text"]
}, Open  ]],

Cell[CellGroupData[{

Cell["Due Date", "Section"],

Cell[TextData[{
  "You can work alone or with a partner on this lab.  The lab is due by 5:00 \
on ",
  StyleBox["Monday, March 8, 2004",
    FontWeight->"Bold"],
  ".  ",
  StyleBox["Make sure to delete all output before you email me your lab!",
    FontColor->RGBColor[1, 0, 0]]
}], "Text"]
}, Open  ]],

Cell[CellGroupData[{

Cell["The Naive DHWT", "Section"],

Cell["\<\
Now we'll generate the \"inefficient\" DHWT.  Using some code developed \
earlier in class, we'll generate matrices H and G that represent the lowpass, \
highpass portions of the DHWT, respectively.  Then we'll use the Join command \
and create the DHWT matrix that is rows x rows in dimension.

Go ahead and execute the cell below.
\
\>", "Text"],

Cell[BoxData[{
    \(\(\(H[r_] := 
        Module[{k, h, rt}, rt = N[Sqrt[2]/2]; 
          h = Table[Which[k \[LessEqual] 2, rt, True, 0], {k, 1, r}]; \ 
          Return[Table[
              RotateRight[h, 2*k - 2], {k, 1, 
                r/2}]]];\)\(\[IndentingNewLine]\)
    \)\), "\[IndentingNewLine]", 
    \(\(\(G[r_] := 
        Module[{k, h, rt}, rt = N[Sqrt[2]/2]; 
          h = Table[
              Which[k \[Equal] 1, rt, k \[Equal] 2, \(-rt\), True, 0], {k, 1, 
                r}]; \ Return[
            Table[RotateRight[h, 2*k - 2], {k, 1, 
                r/2}]]];\)\(\[IndentingNewLine]\)
    \)\), "\[IndentingNewLine]", 
    \(\(DHWT1[r_] := Join[H[r], G[r]];\)\)}], "Input"],

Cell["\<\

Let's test out the DHWT on a list generated by sampling a function.  

In the cell below, I've defined a function, the endpoints a,b of an interval, \
and the number of samples np.  Then I generate a table of sampled function \
values.

Execute the cell below to see every thing defined and a plot of the samples.
\
\>", "Text"],

Cell[BoxData[{
    \(\(f[x_] := x^2;\)\), "\[IndentingNewLine]", 
    \(\(a = 0;\)\), "\[IndentingNewLine]", 
    \(\(b = 1;\)\), "\[IndentingNewLine]", 
    \(\(np = 99;\)\), "\[IndentingNewLine]", 
    \(\(dx = \((b - a)\)/np;\)\), "\[IndentingNewLine]", 
    \(\(d = Table[f[a + k*dx], {k, 0, np}];\)\), "\[IndentingNewLine]", 
    \(\(ListPlot[d];\)\)}], "Input"],

Cell["\<\

You can change the function/values above - just always make sure that np is \
odd.  In this way, the length of d will be even.

Now let's apply the DHWT to d.  The cell below performs the transformation \
and displays the result.
\
\>", "Text"],

Cell[BoxData[{
    \(\(n = Length[d];\)\), "\[IndentingNewLine]", 
    \(\(y = DHWT1[n] . d;\)\), "\[IndentingNewLine]", 
    \(ListPlot[y]\)}], "Input"],

Cell["\<\

For length 100 you should have gotten the picture pretty fast.  Note that the \
first half of the picture is an approximation to the original and the second \
half is the differences.  Since x^2 is a pretty smooth function we expect the \
differences to be small.

Now try changing np=3999 and re-executing the cell.  Notice the slowdown?  

You're generating a 4000 inner products needed to generate y.  Each inner \
product consists of 4000 multiplies so you are doing 4000^2 = 16,000,000 \
multiplies!  This is hardly acceptable, especially when a 1 second sound file \
might consist of 15000 samples.  We will ultimately want to write a more \
efficient transformation.

Before we do that, let's look at something interesting.  In the cell below, \
I've split y into two parts, the lowpass part and the highpass part.  Then \
I've plotted the lowpass portion and (-1) x the highpass portion.  Go ahead \
and execute the cell and then change the definition of f to some other \
function and execute again (you might want to change np to something more \
reasonable).  How does hp relate to lp?
\
\>", "Text"],

Cell[BoxData[{
    \(\(lp = Drop[y, \(-n\)/2];\)\), "\[IndentingNewLine]", 
    \(ListPlot[lp, 
      PlotLabel -> "\<The lowpass portion of y\>"]\), "\[IndentingNewLine]", 
    \(\(lp = Drop[y, n/2];\)\), "\[IndentingNewLine]", 
    \(ListPlot[\(-lp\), 
      PlotLabel -> "\<The highpass portion of y\>"]\), "\[IndentingNewLine]", \

    \(\)}], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell["Task 1", "Section"],

Cell["\<\
You will write a module that takes a list x and efficiently computes the DHWT \
of x.  You know what Hx looks like.  So your module can be done as follows.  \
You should be able to write the lowpass portion of the output as a table and \
the highpass portion of the output as a table.  Then Return the Join of these \
two tables.  

Put the module in the cell below.  After you have it coded, execute it and \
then test it on the cell that follows.  Does the speed increase?
\
\>", "Text"],

Cell[BoxData[
    \(\(\(\[IndentingNewLine]\)\(\(DHWT2[x_] := 
        Module[\({}\)\(,\)];\)\(\[IndentingNewLine]\)
    \)\)\)], "Input"],

Cell[BoxData[{
    \(\(f[x_] := x^2;\)\), "\[IndentingNewLine]", 
    \(\(a = 0;\)\), "\[IndentingNewLine]", 
    \(\(b = 1;\)\), "\[IndentingNewLine]", 
    \(\(np = 3999;\)\), "\[IndentingNewLine]", 
    \(\(dx = \((b - a)\)/np;\)\), "\[IndentingNewLine]", 
    \(\(d = Table[f[a + k*dx], {k, 0, np}];\)\), "\[IndentingNewLine]", 
    \(\(y2 = DHWT2[d];\)\), "\[IndentingNewLine]", 
    \(\(ListPlot[y2];\)\)}], "Input"],

Cell[TextData[{
  "Notice a change?  Your routine should be much faster!\n\nLet's apply our \
DHWT to a digital audio file.  You can find any wav file on the net you like \
or download one from the Math 316 Website and save it to your computer.\n    \
\nGo ahead and change the variables to reflect your folder/file and then \
execute the cell.  \n\nNow go to the Course Web Site and download the file",
  StyleBox[" hellocmp.wav",
    FontWeight->"Bold",
    FontColor->RGBColor[1, 0, 0]],
  StyleBox[". ",
    FontWeight->"Bold"],
  " Store it in your U drive or whatever directory you've created for the \
class.  Enter the director in quotes as the ",
  StyleBox["soundfolder",
    FontWeight->"Bold"],
  " value.\n"
}], "Text"],

Cell[BoxData[{
    \(\(Needs["\<Miscellaneous`Audio`\>"];\)\), "\n", 
    \(\(soundfolder = "\<u:/\>";\)\), "\n", 
    \(\(wav = "\<hellocmp.wav\>";\)\), "\n", 
    \(\(audiofile = soundfolder <> wav;\)\), "\n", 
    \(\(data = 
        ReadSoundFile[audiofile, PrintHeader \[Rule] True];\)\)}], "Input"],

Cell["\<\

If you have executed the cell, you should see some output pertaining to the \
sound file.  Of particular note is the sampling rate.  Change my value for \
srate to the one that matches your sound file.
    
I have denoted the length of the data as n and dropped enough from the list \
so that it is divisible by 8. 

Go ahead and execute the next cell.
\
\>", "Text"],

Cell[BoxData[{
    \(\(srate = 11025;\)\), "\[IndentingNewLine]", 
    \(\(n = Length[data];\)\), "\[IndentingNewLine]", 
    \(\(data = Drop[data, \(-Mod[n, 8]\)];\)\), "\[IndentingNewLine]", 
    \(\(n = Length[data];\)\)}], "Input"],

Cell["\<\

Execute the next cell to hear the audiofile.
\
\>", "Text"],

Cell[BoxData[
    \(\(ListPlay[data, SampleRate \[Rule] srate];\)\)], "Input"],

Cell[TextData[{
  "Now we'll apply the DHWT to this audiofile.  We simply need to compute ",
  StyleBox["DHWT2.data",
    FontWeight->"Bold"],
  ".  We do that in the cell below and name the result ",
  StyleBox["y",
    FontWeight->"Bold"],
  ".  \n    \nThe next cell plays the result. \n"
}], "Text"],

Cell[BoxData[
    \(\(\(\[IndentingNewLine]\)\(\(y = DHWT2[N[data]];\)\[IndentingNewLine]
    \(ListPlay[y, SampleRate \[Rule] srate/2];\)\[IndentingNewLine]
    \)\)\)], "Input"],

Cell["\<\

The next two cells plays just the lowpass and highpass portions, \
respectively.
\
\>", "Text"],

Cell[BoxData[{
    \(\(lp = Take[y, n/2];\)\), "\[IndentingNewLine]", 
    \(\(ListPlay[lp, SampleRate \[Rule] srate/2];\)\)}], "Input"],

Cell[BoxData[{
    \(\(hp = Drop[y, n/2];\)\), "\[IndentingNewLine]", 
    \(\(ListPlay[hp, SampleRate \[Rule] srate/2];\)\)}], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell["Task 2 - The Inverse Discrete Haar Wavelet Transform", "Section"],

Cell[TextData[{
  "Now we need a module to get back from our output to our original data.  \
Since H is orthogonal, the inverse is simply the transpose.  \n\nComplete the \
module below to apply the IDHWT to a list y.  My suggestion on this one would \
be to write out H^Ty and see what the answer looks like.  You should see that \
the inner products go together in pairs. The commands ",
  StyleBox["Transpose",
    FontWeight->"Bold"],
  " and ",
  StyleBox["Flatten",
    FontWeight->"Bold"],
  " along with ",
  StyleBox["Partition",
    FontWeight->"Bold"],
  " will help here.\n"
}], "Text"],

Cell[BoxData[
    \(\(IDHWT2[y_] := Module[\({}\)\(,\)];\)\)], "Input"],

Cell["\<\

Once you have your Module in, test it on the cells below.  
\
\>", "Text"],

Cell[BoxData[{
    \(\(y = DHWT2[N[data]];\)\), "\[IndentingNewLine]", 
    \(\(ListPlay[y, SampleRate \[Rule] srate/2];\)\)}], "Input"],

Cell[BoxData[{
    \(\(orig = IDHWT2[N[y]];\)\), "\[IndentingNewLine]", 
    \(ListPlay[orig, SampleRate \[Rule] srate]\)}], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell["Task 3 - Iterating the Process.", "Section"],

Cell["\<\
What is typically done in practice to get an even more pronounced analysis of \
the differences is to iterate the wavelet transform.  That is, we apply it \
once, and then apply it again to the averages, and then again to the averages \
of the averages.  You save all the differences as you go.

Here is a strung together way to iterate twice on our sound file.  It should \
give you some insight into how to write the module for this task.

First we read in the sound file, adjust the length, and then play the file.
\
\>", "Text"],

Cell["\<\

Next we perform the wavelet transform and listen to the result.
\
\>", "Text"],

Cell[BoxData[{
    \(\(y1 = DHWT2[data];\)\), "\n", 
    \(\(ListPlay[y1, SampleRate \[Rule] srate/2];\)\)}], "Input"],

Cell["\<\

Now we grab just the lowpass part, do the DHWT on it, and play the result.  \
Do you hear the strange sounds in the highpass part?
\
\>", "Text"],

Cell[BoxData[{
    \(\(lp1 = Take[y1, Length[y1]/2];\)\), "\[IndentingNewLine]", 
    \(\(y2 = DHWT2[lp1];\)\), "\[IndentingNewLine]", 
    \(ListPlay[y2, SampleRate \[Rule] srate/4]\)}], "Input"],

Cell["\<\

If I can iterate twice, I can iterate three times (remember our data is a \
multiple of 8).  So I repeat the process.
\
\>", "Text"],

Cell[BoxData[{
    \(\(lp2 = Take[y2, Length[y1]/4];\)\), "\[IndentingNewLine]", 
    \(\(y3 = DHWT2[lp2];\)\), "\[IndentingNewLine]", 
    \(ListPlay[y3, SampleRate \[Rule] srate/8]\)}], "Input"],

Cell["\<\

Now we put the vector back together.
\
\>", "Text"],

Cell[BoxData[{
    \(\(hp1 = Drop[y1, Length[y1]/2];\)\), "\[IndentingNewLine]", 
    \(\(hp2 = Drop[y2, Length[y1]/4];\)\), "\[IndentingNewLine]", 
    \(\(wt = Join[Join[y3, hp2], hp1];\)\), "\[IndentingNewLine]", 
    \(ListPlay[wt, SampleRate \[Rule] srate]\)}], "Input"],

Cell[TextData[{
  "\nIn the cell below, write  a module ",
  StyleBox["DHWT",
    FontWeight->"Bold"],
  " that takes as input a list ",
  StyleBox["x",
    FontWeight->"Bold"],
  " and a number of iterations ",
  StyleBox["i",
    FontWeight->"Bold"],
  " and performs i iterations of the ",
  StyleBox["DHWT",
    FontWeight->"Bold"],
  ".  You will find it beneficial to either call DHWT2 or incorporate it into \
your module.  Each time you iterate, you should replace the lowpass portion \
of the existing list with the new wavelet transform.  \n    \nOnce you have \
your module working, test it on the cells below.\n"
}], "Text"],

Cell[BoxData[
    \(\(DHWT[x_, i_] := Module[\({}\)\(,\)];\)\)], "Input"],

Cell[BoxData[{
    \(\(y = DHWT[data, 3];\)\), "\[IndentingNewLine]", 
    \(\(ListPlay[y, SampleRate \[Rule] srate];\)\)}], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell["Task 4 - Iteration and the Inverse DHWT.", "Section"],

Cell[TextData[{
  "DHWT3 takes as input a vector ",
  StyleBox["x",
    FontWeight->"Bold"],
  " and a number of iterations ",
  StyleBox["i ",
    FontWeight->"Bold"],
  "and performs",
  StyleBox[" i",
    FontWeight->"Bold"],
  " iterations of the Discrete Haar Wavelet Transform.  In this task you will \
write a module to invert the process.  After you complete the module, test it \
on the following cell.    You might want also to change iterations to 1,2 and \
test your module as well.  \n"
}], "Text"],

Cell[BoxData[
    \(\(IDHWT[x_, i_] := Module[\({}\)\(,\)];\)\)], "Input"],

Cell[BoxData[{
    \(\(y = DHWT[N[data], 3];\)\), "\[IndentingNewLine]", 
    \(\(ListPlay[y, SampleRate \[Rule] srate];\)\)}], "Input"],

Cell[BoxData[{
    \(\(orig = IDHWT[N[y], 3];\)\), "\[IndentingNewLine]", 
    \(\(ListPlay[orig, SampleRate \[Rule] srate];\)\)}], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell["Task 5 - Cumulative Energy", "Section"],

Cell[TextData[{
  "\nNow load your ",
  StyleBox["ce",
    FontWeight->"Bold"],
  " function.  The next cell computes and plots the ",
  StyleBox["Cumulative Energy",
    FontWeight->"Bold"],
  " of the original sound file, the ",
  StyleBox["DHWT",
    FontWeight->"Bold"],
  " with one iteration, and the ",
  StyleBox["DHWT",
    FontWeight->"Bold"],
  " with two iterations.  You need only execute the cell below once your ",
  StyleBox["ce ",
    FontWeight->"Bold"],
  "module is working.\n"
}], "Text"],

Cell[BoxData[{
    \(\(wt1 = DHWT[N[data], 1];\)\), "\[IndentingNewLine]", 
    \(\(wt2 = DHWT[N[data], 2];\)\), "\[IndentingNewLine]", 
    \(\(cedata = ce[N[data]];\)\), "\[IndentingNewLine]", 
    \(\(cewt1 = ce[N[wt1]];\)\), "\[IndentingNewLine]", 
    \(\(cewt2 = ce[N[wt2]];\)\), "\[IndentingNewLine]", 
    \(\(p1 = 
        ListPlot[cedata, PlotStyle \[Rule] RGBColor[1, 0, 0], 
          DisplayFunction \[Rule] Identity];\)\), "\[IndentingNewLine]", 
    \(\(p2 = 
        ListPlot[cewt1, PlotStyle \[Rule] RGBColor[0, 1, 0], 
          DisplayFunction \[Rule] Identity];\)\), "\[IndentingNewLine]", 
    \(\(p3 = 
        ListPlot[cewt2, PlotStyle \[Rule] RGBColor[0, 0, 1], 
          DisplayFunction \[Rule] Identity];\)\)}], "Input"],

Cell[BoxData[
    \(\(Show[{p1, p2, p3}, 
        PlotLabel -> "\<Original (red), one iteration (green), two iterations \
(blue)\>", DisplayFunction \[Rule] $DisplayFunction, 
        PlotRange \[Rule] All];\)\)], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell["Task 6 - Cumulative Energy and Compression", "Section"],

Cell[TextData[{
  "\nAs you can see by the above plot, the ",
  StyleBox["DHWT",
    FontWeight->"Bold"],
  " does a good job compressing the cumulative energy.  We can ask for \
components from the ",
  StyleBox["ce",
    FontWeight->"Bold"],
  " vectors and find what percent of the cumulative energy occurs in the \
first",
  StyleBox[" k",
    FontWeight->"Bold"],
  " components.  Execute the cell below to see different percents of energy.\n\
"
}], "Text"],

Cell[BoxData[{
    \(\(num = 2000;\)\), "\[IndentingNewLine]", 
    \(cedata[\([num]\)]\), "\[IndentingNewLine]", 
    \(cewt1[\([num]\)]\), "\[IndentingNewLine]", 
    \(cewt2[\([num]\)]\)}], "Input"],

Cell[TextData[{
  "\nThe numbers above represent the percent of energy in the vector of the \
first num components.  For example, when ",
  StyleBox["num=2000",
    FontWeight->"Bold"],
  ", the original data has",
  StyleBox[" 44%",
    FontWeight->"Bold"],
  " of the data in the first",
  StyleBox[" 2000",
    FontWeight->"Bold"],
  " components and one iteration of ",
  StyleBox["DHWT",
    FontWeight->"Bold"],
  " has",
  StyleBox[" 66%",
    FontWeight->"Bold"],
  " of the data in the first ",
  StyleBox["2000",
    FontWeight->"Bold"],
  " components.\n\nIn this task you will write a module that takes as input a \
percentage ",
  StyleBox["p",
    FontWeight->"Bold"],
  " and a vector ",
  StyleBox["v",
    FontWeight->"Bold"],
  " and returns a number that represents the smallest number of components in \
",
  StyleBox["v",
    FontWeight->"Bold"],
  " that yields ",
  StyleBox["p",
    FontWeight->"Bold"],
  " percent of the energy.  We will call the module ",
  StyleBox["nce",
    FontWeight->"Bold"],
  ".  For example n",
  StyleBox["ce[cewt1,.80]",
    FontWeight->"Bold"],
  " would return the first component in ",
  StyleBox["cewt1",
    FontWeight->"Bold"],
  " whose value is greater than or equal to ",
  StyleBox[".80",
    FontWeight->"Bold"],
  ".  The ",
  StyleBox["Select",
    FontWeight->"Bold"],
  " command we used for our ",
  StyleBox["entropy",
    FontWeight->"Bold"],
  " function will work well here.\n\nWrite the module below.\n"
}], "Text"],

Cell[BoxData[
    \(\(nce[v_, p_] := Module[\({}\)\(,\)];\)\)], "Input"],

Cell[TextData[{
  "\nNow execute the cell below to see how",
  StyleBox[" nce",
    FontWeight->"Bold"],
  " is used.\n"
}], "Text"],

Cell[BoxData[{
    \(\(pct =  .9;\)\), "\[IndentingNewLine]", 
    \(\(ndata = nce[cedata, pct];\)\), "\[IndentingNewLine]", 
    \(\(Print["\<In order to retain \>", 
        pct*100, "\<% of the energy in the original data, we must retain the \
\>", ndata, "\< largest elements in the data.\>"];\)\), \
"\[IndentingNewLine]", 
    \(\(nwt1 = nce[cewt1, pct];\)\), "\[IndentingNewLine]", 
    \(\(Print["\<In order to retain \>", 
        pct*100, "\<% of the energy in one iteration of the DHWT, we must \
retain the \>", 
        nwt1, "\< largest elements in the data.\>"];\)\), \
"\[IndentingNewLine]", 
    \(\(nwt2 = nce[cewt2, pct];\)\), "\[IndentingNewLine]", 
    \(\(Print["\<In order to retain \>", 
        pct*100, "\<% of the energy in two iterations of the DHWT, we must \
retain the \>", nwt2, "\< largest elements in the data.\>"];\)\)}], "Input"],

Cell[TextData[{
  "\nNow that you have the nCE routine let's use it.  Suppose you have the \
cumulative energy vector ",
  StyleBox["vce ",
    FontWeight->"Bold"],
  "computed from vector",
  StyleBox[" v",
    FontWeight->"Bold"],
  ".  For the sake of argument, let's say",
  StyleBox[" v",
    FontWeight->"Bold"],
  " has ",
  StyleBox["100",
    FontWeight->"Bold"],
  " components and with",
  StyleBox[" pct=.95",
    FontWeight->"Bold"],
  ", you found that ",
  StyleBox["nce",
    FontWeight->"Bold"],
  " returns",
  StyleBox[" 37",
    FontWeight->"Bold"],
  ".  What we need to do now is to return to our original v and compress it.  \
That is, we want to retain only the largest ",
  StyleBox["37",
    FontWeight->"Bold"],
  " values of ",
  StyleBox["v",
    FontWeight->"Bold"],
  " (in absolute value) and convert the rest to",
  StyleBox[" 0",
    FontWeight->"Bold"],
  ".  The idea is that our \"new\" v will be easier to compress (via WinZip, \
let's say) and send over the internet.  Of course, we will lose some \
precision, but our transmit time will shrink.\n\nIn the cell below, write a \
module called ",
  StyleBox["comp",
    FontWeight->"Bold"],
  " that takes as input a vector ",
  StyleBox["v",
    FontWeight->"Bold"],
  " and an integer ",
  StyleBox["k",
    FontWeight->"Bold"],
  ".  The routine should find the ",
  StyleBox["k",
    FontWeight->"Bold"],
  "th largest value of ",
  StyleBox["v",
    FontWeight->"Bold"],
  " (in absolute) and then converts to ",
  StyleBox["0",
    FontWeight->"Bold"],
  " any value smaller.  A command that is really handy for this module is ",
  StyleBox["Chop",
    FontWeight->"Bold"],
  ".   ",
  StyleBox["Chop",
    FontWeight->"Bold"],
  " takes a vector (or an expression) and a tolerance and if the vector \
component is smaller (in absolute value) than the tolerance, it replaces the \
value with ",
  StyleBox["0",
    FontWeight->"Bold"],
  ".  Execute the cell below to see how ",
  StyleBox["Chop",
    FontWeight->"Bold"],
  " works.  Bear in mind, ",
  StyleBox["Chop",
    FontWeight->"Bold"],
  " needs ",
  StyleBox["numerical input",
    FontWeight->"Bold"],
  "."
}], "Text"],

Cell[BoxData[{
    \(\(q = {1, \(-3\), 2, \(-6\), 7, 
          7, \(-9\)};\)\), "\[IndentingNewLine]", 
    \(Chop[N[q], 4]\), "\[IndentingNewLine]", 
    \(Chop[N[q], 7]\)}], "Input"],

Cell[TextData[{
  "\nWrite the code for module ",
  StyleBox["Comp",
    FontWeight->"Bold"],
  " below.\n  "
}], "Text"],

Cell[BoxData[
    \(\(comp[v_, k_] := Module[];\)\)], "Input"],

Cell[TextData[{
  "\n\nNow we will compress the wavelet transforms and then invert them.  In \
the cell above, you determined how many values were needed to produce 90% of \
the energy.  The ",
  StyleBox["Comp",
    FontWeight->"Bold"],
  " function will zero out all but the largest values specified by ",
  StyleBox["nCE",
    FontWeight->"Bold"],
  ".  Then you will inverse transform this modified vector and listen to the \
result.  How does it sound?\n\nExecute the next two cells to find out.\n"
}], "Text"],

Cell[BoxData[{
    \(\(newwt1 = comp[wt1, nwt1];\)\), "\[IndentingNewLine]", 
    \(\(orig1 = IDHWT[N[newwt1], 1];\)\), "\[IndentingNewLine]", 
    \(\(ListPlay[orig1, SampleRate \[Rule] srate];\)\)}], "Input"],

Cell[BoxData[{
    \(\(newwt2 = comp[wt2, nwt2];\)\), "\[IndentingNewLine]", 
    \(\(orig2 = IDHWT[N[newwt2], 2];\)\), "\[IndentingNewLine]", 
    \(\(ListPlay[orig2, SampleRate \[Rule] srate];\)\)}], "Input"],

Cell[TextData[{
  "\nGo back and change",
  StyleBox[" pct ",
    FontWeight->"Bold"],
  "to ",
  StyleBox[".6",
    FontWeight->"Bold"],
  " and then recompute ",
  StyleBox["nwt1",
    FontWeight->"Bold"],
  ", ",
  StyleBox["nwt2",
    FontWeight->"Bold"],
  ",  Next execute the above to cells to hear the result.  Do the procedure \
again with",
  StyleBox[" pct=.8",
    FontWeight->"Bold"],
  " and ",
  StyleBox["pct=.95",
    FontWeight->"Bold"],
  ".\n"
}], "Text"]
}, Open  ]],

Cell[CellGroupData[{

Cell["Task 7 - Testing IDHWT", "Section"],

Cell[TextData[{
  "\nThis is mostly for fun (assuming your ",
  StyleBox["IDHWT",
    FontWeight->"Bold"],
  " is working).  Go to the website (under Images and Sound Files) and save \
to disk the five files ",
  StyleBox["sounddata1.raw",
    FontWeight->"Bold"],
  ", ",
  StyleBox["sounddata2.raw",
    FontWeight->"Bold"],
  ",...,",
  StyleBox["sounddata5.raw",
    FontWeight->"Bold"],
  ".   These are all sound files that have had the ",
  StyleBox["DHWT ",
    FontWeight->"Bold"],
  "applied to them with different numbers of iterations.  \n\nThe cell below \
reads in the sounddata1.raw file (you'll have to modify the file name path) \
and then plays it.\n"
}], "Text"],

Cell[BoxData[{
    \(\(sndfile = "\<u:/sounddata1.raw\>";\)\), "\[IndentingNewLine]", 
    \(\(f = OpenRead[sndfile];\)\), "\[IndentingNewLine]", 
    \(\(data = ReadList[f, Number];\)\), "\[IndentingNewLine]", 
    \(\(srate = data[\([1]\)];\)\), "\[IndentingNewLine]", 
    \(\(v = Drop[data, 1];\)\), "\[IndentingNewLine]", 
    \(\(ListPlay[v, SampleRate \[Rule] srate];\)\), "\[IndentingNewLine]", 
    \(\(Print["\<The sample rate is \>", 
        srate, \ "\< and the number of samples is \>", 
        Length[v], "\<.\>"];\)\)}], "Input"],

Cell[TextData[{
  "\nAfter listening to the sound file, make a guess at the number of \
iterations there are and then fill in that value below and use it to perform \
the ",
  StyleBox["IDHWT",
    FontWeight->"Bold"],
  " and then play your guess at the original sound.  \n"
}], "Text"],

Cell[BoxData[{
    \(\(\(\(iterations\)\(=\)\);\)\), "\[IndentingNewLine]", 
    \(\(orig = IDHWT[N[v], iterations];\)\), "\[IndentingNewLine]", 
    \(\(ListPlay[orig, SampleRate \[Rule] srate];\)\)}], "Input"],

Cell["\<\

Re-execute the previous two cells for each of sounddata2.raw, ... \
sounddata5.raw.  These are all clips from movies.  Fill in the movie titles \
below to finish the problem:

Clip 1 is from the movie: 

Clip 2 is from the movie: 

Clip 3 is from the movie: 

Clip 4 is from the movie: 

Clip 5 is from the movie: 
\
\>", "Text"]
}, Open  ]]
}, Open  ]]
},
FrontEndVersion->"5.0 for Microsoft Windows",
ScreenRectangle->{{0, 1024}, {0, 695}},
WindowSize->{1016, 668},
WindowMargins->{{0, Automatic}, {Automatic, 0}},
StyleDefinitions -> "Report.nb"
]

(*******************************************************************
Cached data follows.  If you edit this Notebook file directly, not
using Mathematica, you must remove the line containing CacheID at
the top of  the file.  The cache data will then be recreated when
you save this file from within Mathematica.
*******************************************************************)

(*CellTagsOutline
CellTagsIndex->{}
*)

(*CellTagsIndex
CellTagsIndex->{}
*)

(*NotebookFileOutline
Notebook[{

Cell[CellGroupData[{
Cell[1776, 53, 42, 0, 81, "Title"],
Cell[1821, 55, 55, 0, 39, "Subtitle"],

Cell[CellGroupData[{
Cell[1901, 59, 27, 0, 67, "Section"],
Cell[1931, 61, 269, 5, 46, "Text"]
}, Open  ]],

Cell[CellGroupData[{
Cell[2237, 71, 27, 0, 67, "Section"],
Cell[2267, 73, 291, 8, 29, "Text"]
}, Open  ]],

Cell[CellGroupData[{
Cell[2595, 86, 33, 0, 67, "Section"],
Cell[2631, 88, 357, 8, 97, "Text"],
Cell[2991, 98, 697, 16, 155, "Input"],
Cell[3691, 116, 339, 10, 131, "Text"],
Cell[4033, 128, 367, 7, 155, "Input"],
Cell[4403, 137, 255, 8, 97, "Text"],
Cell[4661, 147, 153, 3, 75, "Input"],
Cell[4817, 152, 1122, 22, 233, "Text"],
Cell[5942, 176, 356, 8, 115, "Input"]
}, Open  ]],

Cell[CellGroupData[{
Cell[6335, 189, 25, 0, 67, "Section"],
Cell[6363, 191, 499, 10, 97, "Text"],
Cell[6865, 203, 138, 3, 75, "Input"],
Cell[7006, 208, 422, 8, 175, "Input"],
Cell[7431, 218, 732, 16, 165, "Text"],
Cell[8166, 236, 304, 6, 115, "Input"],
Cell[8473, 244, 378, 11, 148, "Text"],
Cell[8854, 257, 235, 4, 95, "Input"],
Cell[9092, 263, 70, 4, 63, "Text"],
Cell[9165, 269, 78, 1, 35, "Input"],
Cell[9246, 272, 303, 8, 80, "Text"],
Cell[9552, 282, 179, 3, 95, "Input"],
Cell[9734, 287, 106, 5, 63, "Text"],
Cell[9843, 294, 136, 2, 55, "Input"],
Cell[9982, 298, 136, 2, 55, "Input"]
}, Open  ]],

Cell[CellGroupData[{
Cell[10155, 305, 71, 0, 67, "Section"],
Cell[10229, 307, 598, 15, 97, "Text"],
Cell[10830, 324, 71, 1, 35, "Input"],
Cell[10904, 327, 85, 4, 63, "Text"],
Cell[10992, 333, 136, 2, 55, "Input"],
Cell[11131, 337, 133, 2, 55, "Input"]
}, Open  ]],

Cell[CellGroupData[{
Cell[11301, 344, 50, 0, 67, "Section"],
Cell[11354, 346, 542, 11, 131, "Text"],
Cell[11899, 359, 89, 4, 63, "Text"],
Cell[11991, 365, 118, 2, 55, "Input"],
Cell[12112, 369, 156, 5, 63, "Text"],
Cell[12271, 376, 196, 3, 75, "Input"],
Cell[12470, 381, 143, 5, 63, "Text"],
Cell[12616, 388, 196, 3, 75, "Input"],
Cell[12815, 393, 62, 4, 63, "Text"],
Cell[12880, 399, 275, 4, 95, "Input"],
Cell[13158, 405, 636, 17, 114, "Text"],
Cell[13797, 424, 73, 1, 35, "Input"],
Cell[13873, 427, 133, 2, 55, "Input"]
}, Open  ]],

Cell[CellGroupData[{
Cell[14043, 434, 59, 0, 67, "Section"],
Cell[14105, 436, 511, 14, 63, "Text"],
Cell[14619, 452, 74, 1, 35, "Input"],
Cell[14696, 455, 136, 2, 55, "Input"],
Cell[14835, 459, 140, 2, 55, "Input"]
}, Open  ]],

Cell[CellGroupData[{
Cell[15012, 466, 45, 0, 67, "Section"],
Cell[15060, 468, 509, 17, 80, "Text"],
Cell[15572, 487, 747, 14, 175, "Input"],
Cell[16322, 503, 222, 4, 55, "Input"]
}, Open  ]],

Cell[CellGroupData[{
Cell[16581, 512, 61, 0, 67, "Section"],
Cell[16645, 514, 462, 14, 80, "Text"],
Cell[17110, 530, 201, 4, 95, "Input"],
Cell[17314, 536, 1491, 53, 182, "Text"],
Cell[18808, 591, 72, 1, 35, "Input"],
Cell[18883, 594, 132, 5, 63, "Text"],
Cell[19018, 601, 865, 16, 215, "Input"],
Cell[19886, 619, 2174, 75, 165, "Text"],
Cell[22063, 696, 185, 4, 75, "Input"],
Cell[22251, 702, 121, 5, 63, "Text"],
Cell[22375, 709, 62, 1, 35, "Input"],
Cell[22440, 712, 515, 11, 131, "Text"],
Cell[22958, 725, 210, 3, 75, "Input"],
Cell[23171, 730, 210, 3, 75, "Input"],
Cell[23384, 735, 475, 21, 63, "Text"]
}, Open  ]],

Cell[CellGroupData[{
Cell[23896, 761, 41, 0, 67, "Section"],
Cell[23940, 763, 681, 20, 114, "Text"],
Cell[24624, 785, 546, 9, 155, "Input"],
Cell[25173, 796, 287, 7, 80, "Text"],
Cell[25463, 805, 211, 3, 75, "Input"],
Cell[25677, 810, 340, 16, 233, "Text"]
}, Open  ]]
}, Open  ]]
}
]
*)



(*******************************************************************
End of Mathematica Notebook file.
*******************************************************************)