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

                    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[     22234,        648]*)
(*NotebookOutlinePosition[     22899,        671]*)
(*  CellTagsIndexPosition[     22855,        667]*)
(*WindowFrame->Normal*)



Notebook[{

Cell[CellGroupData[{
Cell["Haar Image Compression", "Subtitle"],

Cell["\<\
Patrick J. Van Fleet
Minicourse #5, Joint Mathematics Meetings
New Orleans, LA\
\>", "Subsubtitle"],

Cell["Objective", "Section"],

Cell[CellGroupData[{

Cell["\<\
In this notebook, we will learn how to perform naive image compression using \
the 2D Haar Wavelet Transform.\
\>", "Subsubtitle"],

Cell["Conventions", "Section"]
}, Open  ]],

Cell[CellGroupData[{

Cell[TextData[{
  "This notebook uses the package ",
  StyleBox["WaveletFunctions",
    FontColor->RGBColor[0.501961, 0, 0]],
  " (written by Patrick Van Fleet).  All commands from the WaveletFunctions \
library will be denoted in ",
  StyleBox["maroon",
    FontColor->RGBColor[0.501961, 0, 0]],
  ".  Help is available for almost every command in ",
  StyleBox["WaveletFunctions",
    FontColor->RGBColor[0.501961, 0, 0]],
  ".  Click on Help and then Help Browser (or Shift F1).  Next click the \
Add-ons & Links tab.  Scroll down until you find ",
  StyleBox["WaveletFunctions",
    FontColor->RGBColor[0.501961, 0, 0]],
  ".  Like all ",
  StyleBox["Mathematica",
    FontSlant->"Italic"],
  " help screens, the help is \"live\" - you can either execute the commands \
in the help to see the effects of the command or cut and paste them into your \
own notebook.\n\nValues that can be changed by the user are defined using ",
  StyleBox["blue",
    FontColor->RGBColor[0, 0, 1]],
  ".\n\nComments are useful within cells of code.  Any code enclosed by (*  \
*) is a comment and ignored by the ",
  StyleBox["Mathematica",
    FontSlant->"Italic"],
  " kernel."
}], "Subsubtitle"],

Cell[CellGroupData[{

Cell["Load WaveletFunctions", "Section"],

Cell[BoxData[
    \(\(\(<< WaveletFunctions`WaveletFunctions`\)\(\[IndentingNewLine]\)
    \)\)], "Input"]
}, Open  ]],

Cell["Spelling Off", "Section"]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
This turns off the annoying error messages you get when the spelling of two \
variable names is close.\
\>", "Subsubtitle"],

Cell[BoxData[{
    \(\(Off[General::spell];\)\), "\[IndentingNewLine]", 
    \(\(Off[General::spell1];\)\)}], "Input"],

Cell["Huffman Encoding", "Section"]
}, Open  ]],

Cell[CellGroupData[{

Cell[TextData[{
  "Here is a module written by two students to perform Huffman encoding.  \
They learned a lot of ",
  StyleBox["Mathematica",
    FontSlant->"Italic"],
  " in the process!  The input variable can be in the form of a list, matrix, \
or a string.  The routine returns all the codes, the length of the original \
bit stream, and the length of the encoded bit stream."
}], "Subsubtitle"],

Cell[BoxData[
    \(\(MakeHuffmanCodes[str_] := 
        Module[{tst, char, freq, probs, s, Codes, retst, obl, 
            nbl}, \[IndentingNewLine]tst = 
            If[AtomQ[str] \[Equal] True, Characters[str], 
              Map[Floor, Flatten[str]]]; \[IndentingNewLine]char = 
            Union[tst]; \[IndentingNewLine]freq = 
            Map[Length, Split[Sort[tst]]]; \nprobs = freq/Length[tst]; \n
          s = Sort[MapThread[List, {probs, Range[Length[probs]]}, 1]]; \n
          While[\((Length[s] - 2 \[GreaterEqual] 
                0)\), \[IndentingNewLine]\(s = 
                Sort[Delete[
                    Prepend[
                      s, {s[\([1, 1]\)] + s[\([2, 1]\)], {s[\([1, 2]\)], 
                          s[\([2, 2]\)]}}], {{2}, {3}}]];\)]; \n
          Codes = Flatten[
              Table[Position[FlattenAt[Drop[FlattenAt[s, 1], 1], 1], i] - 
                  1, {i, Length[probs]}], 1]; \n
          retst = MapThread[List, {char, probs, Codes}]; \n
          obl = 8*Length[tst]; \n
          nbl = Map[Length, Codes] . freq; \[IndentingNewLine]Return[{retst, 
              obl, nbl}]];\)\)], "Input"],

Cell["Locating Images", "Section"]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
If you have access to the internet, then use the imgdir variable that is \
listed for the internet.  Else, use the imgdir for images already stored on \
your computer.  If you have your own image, create a url/folder location as \
the imgdir variable.\
\>", "Subsubtitle"],

Cell[BoxData[
    RowBox[{\( (*\ 
        This\ variable\ is\ the\ location\ of\ images\ on\ the\ \
\(\(web\)\(.\)\)\ *) \), "\[IndentingNewLine]", 
      RowBox[{
        StyleBox[\(imgdir = \
"\<http://cam.mathlab.stthomas.edu/pvf/Math316/TestImages/\>";\),
          FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", 
        "\[IndentingNewLine]", \( (*\ 
          This\ variable\ is\ the\ location\ of\ images\ on\ the\ local\ \
\(\(computer\)\(.\)\)\ *) \), "\[IndentingNewLine]", 
        RowBox[{"(*", " ", 
          
          StyleBox[\(imgdir\  = \ $BaseDirectory <> "\<\\Applications\\Images\
\\\>";\),
            FontColor->RGBColor[0, 0, 1]], " ", "*)"}], "\[IndentingNewLine]",
         "\[IndentingNewLine]", \( (*\ 
          You\ can\ create\ your\ own\ version\ of\ imgdir\ \
\(\(below\)\(.\)\)\ *) \), "\[IndentingNewLine]", 
        RowBox[{"(*", " ", 
          StyleBox[\(\(\(imgdir\)\(\ \)\(=\)\)\ ;\),
            FontColor->RGBColor[0, 0, 1]], " ", "*)"}], 
        "\[IndentingNewLine]"}]}]], "Input"],

Cell["Available Images", "Section"]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
Here is a list of images for use with this notebook.  Surprisingly cartoons \
work really well!  Some images work better than others.  Uncomment one of the \
images.  You can also add your own image!\
\>", "Subsubtitle"],

Cell[BoxData[
    RowBox[{
      RowBox[{"(*", " ", 
        StyleBox[\(image\  = \ "\<beatles.png\>";\),
          FontColor->RGBColor[0, 0, 1]], 
        StyleBox[" ",
          FontColor->RGBColor[0, 0, 1]], "*)"}], "\[IndentingNewLine]", 
      RowBox[{"(*", " ", 
        StyleBox[\(image = \ "\<calvin_hobbes_gray.jpg\>";\),
          FontColor->RGBColor[0, 0, 1]], 
        StyleBox[" ",
          FontColor->RGBColor[0, 0, 1]], "*)"}], "\[IndentingNewLine]", 
      RowBox[{"(*", " ", 
        StyleBox[\(image\  = \ "\<fingerprint.gif\>";\),
          FontColor->RGBColor[0, 0, 1]], " ", "*)"}], "\[IndentingNewLine]", 
      " ", 
      RowBox[{
        StyleBox[\(image\  = \ "\<garfield_gray.jpg\>";\),
          FontColor->RGBColor[0, 0, 1]], " ", "\[IndentingNewLine]", 
        RowBox[{"(*", " ", 
          StyleBox[\(image\  = \ "\<moonsurface.png\>";\),
            FontColor->RGBColor[0, 0, 1]], " ", "*)"}], "\[IndentingNewLine]",
         
        RowBox[{"(*", " ", 
          StyleBox[\(image = "\<snoopy_gray.jpg\>";\),
            FontColor->RGBColor[0, 0, 1]], " ", "*)"}], "\[IndentingNewLine]",
         
        RowBox[{"(*", " ", 
          StyleBox[\(image\  = \ "\<spockkirkmccoy.png\>";\),
            FontColor->RGBColor[0, 0, 1]], " ", "*)"}], "\[IndentingNewLine]",
         
        RowBox[{"(*", " ", 
          StyleBox[\(image\  = \ "\<stooges.gif\>";\),
            FontColor->RGBColor[0, 0, 1]], " ", "*)"}], "\[IndentingNewLine]",
         
        RowBox[{"(*", " ", 
          StyleBox[\(\(\(image\)\(\ \)\(=\)\)\ ;\),
            FontColor->RGBColor[0, 0, 1]], " ", "*)"}]}]}]], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell[TextData[{
  "Here are some maximum iteration numbers for our image list:\n\n",
  StyleBox["File",
    FontWeight->"Bold"],
  "\t\t\t\t",
  StyleBox["Max Iterations",
    FontWeight->"Bold"],
  "\nbeatles.png\t\t\t\t2\ncalvin_hobbes_gray.jpg\t\t5\nfingerprint.gif\t\t\t\
\t7\ngarfield_gray.jpg\t\t\t3\nmoonsurface.png\t\t\t3\t\nsnoopy_gray.jpg\t\t\t\
1\nspockkirkmccoy.png\t\t\t3\nstooges.gif\t\t\t\t5"
}], "Subsubtitle"],

Cell["Load an Image", "Section"]
}, Open  ]],

Cell[CellGroupData[{

Cell["We first load an image.", "Subsubtitle"],

Cell[BoxData[{
    RowBox[{
      RowBox[{
        RowBox[{"A", "=", 
          StyleBox[\(ReadImage[imgdir <> image, PrintInfo \[Rule] True]\),
            FontColor->RGBColor[0.501961, 0, 0]]}], 
        StyleBox[";",
          FontColor->RGBColor[0.501961, 0, 0]]}], 
      "\n", \( (*\ If\ your\ image\ was\ processed\ as\ a\ color\ image, \ 
        uncomment\ the\ line\ below\ to\ convert\ \(\(it\)\(.\)\)\ *) \), 
      "\[IndentingNewLine]", \( (*\ \(A\  = \ 
            Total[A]/3;\)\ *) \)}], "\[IndentingNewLine]", 
    RowBox[{\({rows, cols} = Dimensions[A];\), "\n"}], "\[IndentingNewLine]", 
  
    StyleBox[\(ImagePlot[A, Frame \[Rule] True, FrameTicks \[Rule] False];\),
      FontColor->RGBColor[0.501961, 0, 0]]}], "Input"],

Cell["Compute the Wavelet Transform", "Section"]
}, Open  ]],

Cell[CellGroupData[{

Cell["We first compute the 2D HWT.", "Subsubtitle"],

Cell[BoxData[{
    StyleBox[\(its = 2;\),
      FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", 
    RowBox[{
      RowBox[{"B", " ", "=", " ", 
        StyleBox[\(WT2D[A, {1/2, 1/2}, NumIterations \[Rule] its]\),
          FontColor->RGBColor[0.501961, 0, 0]]}], 
      StyleBox[";",
        FontColor->RGBColor[0.501961, 0, 0]]}], "\[IndentingNewLine]", 
    StyleBox[\(WaveletDensityPlot[B, NumIterations \[Rule] its, 
          DivideLines \[Rule] True];\),
      FontColor->RGBColor[0.501961, 0, 0]]}], "Input"],

Cell["Lossless Compression", "Section"]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
In this form of compression, we simply encode the transform.  The image can \
be recovered exactly in lossless compression.\
\>", "Subsubtitle"],

Cell[BoxData[{
    \(\({codes, totalbits, encodedbits} = 
        MakeHuffmanCodes[B];\)\), "\[IndentingNewLine]", 
    \(\(bpp\  = \ 
        N[encodedbits]/\((rows*cols)\);\)\), "\[IndentingNewLine]", 
    \(\(Print["\<The number of bits in the original image is \>", 
        rows, "\< x \>", cols, "\< x 8 = \>", 
        totalbits, "\<.\>"];\)\), "\[IndentingNewLine]", 
    \(\(Print["\<The bitstream length of the transformed data is \>", 
        encodedbits, "\< or \>", 
        bpp, "\< bpp.\>"];\)\), "\[IndentingNewLine]", 
    \(\(Print["\<The new bitstream length is about \>", 
        Round[10000*bpp/8]/
          100. , "\<% of the original bitstream length.\>"];\)\)}], "Input"],

Cell["To Consider...", "Section"]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
1) What happens if we increase the number of iterations?

2) Try lossless compression with different images and different numbers of \
iterations.\
\>", "Subsubtitle"],

Cell["Lossy Compression", "Section"]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
We now add a quantization step between transforming the data and encoding the \
transform.  The idea here is that we convert transform values that are \
\"small\" to zero and thus improve the performance by the Huffman encoder.\
\>", "Subsubtitle"],

Cell["Cumulative Energy", "Section"]
}, Open  ]],

Cell[CellGroupData[{

Cell[TextData[{
  "We will use cumulative energy to perform quantization.  The command in ",
  StyleBox["WaveletFunctions",
    FontColor->RGBColor[0.501961, 0, 0]],
  " to compute the cumulative energy is ",
  StyleBox["CE",
    FontColor->RGBColor[0.501961, 0, 0]],
  ".  It takes either a vector or a matrix as input.\n\nHere is the \
cumulative energy vector for our original image."
}], "Subsubtitle"],

Cell[BoxData[{
    RowBox[{
      RowBox[{"ceA", " ", "=", " ", 
        StyleBox[\(CE[A]\),
          FontColor->RGBColor[0.501961, 0, 0]]}], 
      StyleBox[";",
        FontColor->RGBColor[0.501961, 0, 
        0]]}], "\[IndentingNewLine]", \(ListPlot[ceA, 
        PlotStyle \[Rule] Red];\)}], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
Here is the cumulative energy vector for our transformed image.   I've \
printed out an element from the vector to give you an idea how to read the \
elements of the vector.\
\>", "Subsubtitle"],

Cell[BoxData[{
    RowBox[{
      RowBox[{"ceB", " ", "=", " ", 
        StyleBox[\(CE[B]\),
          FontColor->RGBColor[0.501961, 0, 0]]}], 
      StyleBox[";",
        FontColor->RGBColor[0.501961, 0, 
        0]]}], "\[IndentingNewLine]", \(plot\  = \ 
        ListPlot[ceB, PlotStyle \[Rule] Blue];\), "\[IndentingNewLine]", 
    StyleBox[\(i = rows*cols/8;\),
      FontColor->RGBColor[0, 0, 
      1]], "\[IndentingNewLine]", \(pct\  = \ 
        Round[ceB[\([i]\)]*10000]/100. ;\), "\[IndentingNewLine]", \(Print[
        pct, "\< of the energy is stored in the largest (in absolute value) \
\>", i, "\< elements of B.\>"];\)}], "Input"],

Cell[" Quantizing with Cumulative Energy", "Section"]
}, Open  ]],

Cell[CellGroupData[{

Cell[TextData[{
  "To quantize with cumulative energy, we will first pick an energy level 0 \
\[LessEqual] p \[LessEqual] 1 and then determine the largest elements (in \
absolute value) in B that comprise p units of the energy.  There is a command \
in ",
  StyleBox["WaveletFunctions",
    FontColor->RGBColor[0.501961, 0, 0]],
  " called ",
  StyleBox["nCE",
    FontColor->RGBColor[0.501961, 0, 0]],
  " that will perform this task.    The module takes the cumulative energy \
vector and p and returns the number of elements m from B that constitute p \
units of energy."
}], "Subsubtitle"],

Cell[BoxData[{\(p =  .998;\), "\[IndentingNewLine]", 
    RowBox[{
      RowBox[{"k", "=", 
        StyleBox[\(nCE[ceB, p]\),
          FontColor->RGBColor[0.501961, 0, 0]]}], 
      StyleBox[";",
        FontColor->RGBColor[0.501961, 0, 
        0]]}], "\[IndentingNewLine]", \(Print["\<The largest (in absolute \
value) \>", k, "\< elements of B constitute \>", 
        100*p, "\<% of the energy of B.\>"];\)}], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell[TextData[{
  "Here is a graphical interpretation of ",
  StyleBox["nCE",
    FontColor->RGBColor[0.501961, 0, 0]],
  "."
}], "Subsubtitle"],

Cell[BoxData[{
    \(\(line1 = 
        Graphics[{RGBColor[ .5,  .3,  .2], 
            Line[{{1, p}, {rows*cols, p}}]}];\)\), "\[IndentingNewLine]", 
    \(\(line2 = 
        Graphics[{RGBColor[0,  .5, 0], 
            Line[{{k, First[ceB]}, {k, 1}}]}];\)\), "\[IndentingNewLine]", 
    \(\(Show[{plot, line1, line2}];\)\), "\[IndentingNewLine]", 
    \(\)}], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell[TextData[{
  "We next convert all but the largest (in absolute value) k values of B to \
0.  The module in ",
  StyleBox["WaveletFunctions",
    FontColor->RGBColor[0.501961, 0, 0]],
  " to perform this task is ",
  StyleBox["Comp",
    FontColor->RGBColor[0.501961, 0, 0]],
  ".  ",
  StyleBox["Comp",
    FontColor->RGBColor[0.501961, 0, 0]],
  " takes a matrix or vector and the value k and first finds the kth largest \
element (in absolute value) q in the input.    ",
  StyleBox["Comp",
    FontColor->RGBColor[0.501961, 0, 0]],
  " then sets to 0 all values in the input that are smaller (in absolute \
value) than q and returns the result.\n\nHere is a simple example of ",
  StyleBox["Comp",
    FontColor->RGBColor[0.501961, 0, 0]],
  "."
}], "Subsubtitle"],

Cell[BoxData[
    StyleBox[\(Comp[{1, \(-2\), 3, 4, \(-5\)}, 3]\),
      FontColor->RGBColor[0.501961, 0, 0]]], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell[TextData[{
  "For our transform B, here is the result of ",
  StyleBox["Comp",
    FontColor->RGBColor[0.501961, 0, 0]],
  ".  Try replacing k by other values (smaller than rows*cols).  For the \
Garfield image, try values 1000, 2500, 3000, and 5000."
}], "Subsubtitle"],

Cell[BoxData[{
    RowBox[{
      RowBox[{"newB", "=", 
        StyleBox[\(Comp[B, 2500]\),
          FontColor->RGBColor[0.501961, 0, 0]]}], 
      StyleBox[";",
        FontColor->RGBColor[0.501961, 0, 0]]}], "\[IndentingNewLine]", 
    StyleBox[\(WaveletDensityPlot[newB, NumIterations \[Rule] its, 
          DivideLines \[Rule] True];\),
      FontColor->RGBColor[0.501961, 0, 0]]}], "Input"],

Cell["Lossy Compression", "Section"]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
We are ready to put everything together and compress an image using lossy \
compression.  Understand that we can never exactly recover the original image \
using lossy compression.

First we read an image and compute its 2D HWT.  Feel free to change the image \
or the value for its.\
\>", "Subsubtitle"],

Cell[BoxData[{
    StyleBox[\(image = "\<calvin_hobbes_gray.jpg\>";\),
      FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", 
    RowBox[{
      RowBox[{"A", "=", 
        StyleBox[\(ReadImage[imgdir <> image]\),
          FontColor->RGBColor[0.501961, 0, 0]]}], 
      StyleBox[";",
        FontColor->RGBColor[0.501961, 0, 0]]}], "\[IndentingNewLine]", 
    StyleBox[\(ImagePlot[A, LinearScaling \[Rule] True];\),
      FontColor->RGBColor[0.501961, 0, 
      0]], "\[IndentingNewLine]", \({rows, cols} = 
        Dimensions[A];\), "\[IndentingNewLine]", 
    RowBox[{\(Print["\<The bit stream for this image has length \>", 
          rows*cols*8, "\<.\>"];\), 
      "\[IndentingNewLine]"}], "\[IndentingNewLine]", 
    StyleBox[\(its = 3;\),
      FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", 
    RowBox[{
      RowBox[{"B", "=", 
        StyleBox[\(WT2D[A, {1/2, 1/2}, NumIterations \[Rule] its]\),
          FontColor->RGBColor[0.501961, 0, 0]]}], 
      StyleBox[";",
        FontColor->RGBColor[0.501961, 0, 0]]}], "\[IndentingNewLine]", 
    StyleBox[\(WaveletDensityPlot[B, NumIterations \[Rule] its, 
          DivideLines \[Rule] True];\),
      FontColor->RGBColor[0.501961, 0, 0]]}], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
Next we compute the cumulative energy vector and compress it.  Feel free to \
change the value for p.  I have \"wrapped\" B in N[ ] - this converts the \
input to decimal values and decreases computation time.\
\>", "Subsubtitle"],

Cell[BoxData[{
    RowBox[{
      RowBox[{
        StyleBox["ceB",
          FontColor->GrayLevel[0]], 
        StyleBox["=",
          FontColor->GrayLevel[0]], 
        StyleBox[\(CE[N[B]]\),
          FontColor->RGBColor[0.501961, 0, 0]]}], 
      StyleBox[";",
        FontColor->RGBColor[0.501961, 0, 0]]}], "\[IndentingNewLine]", 
    RowBox[{\(ListPlot[ceB, PlotStyle \[Rule] Blue];\), 
      "\[IndentingNewLine]"}], "\[IndentingNewLine]", 
    StyleBox[\(p =  .995;\),
      FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", 
    RowBox[{
      RowBox[{
        RowBox[{"k", "=", 
          StyleBox[\(nCE[ceB, p]\),
            FontColor->RGBColor[0.501961, 0, 0]]}], 
        StyleBox[";",
          FontColor->RGBColor[0.501961, 0, 0]]}], 
      "\[IndentingNewLine]"}], "\[IndentingNewLine]", \(Print["\<The largest \
(in absolute value) \>", k, "\< elements of B constitute \>", 
        Round[10000*p]/
          100. , "\<% of the energy of B.\>"];\), "\[IndentingNewLine]", 
    RowBox[{\(Print[rows*cols - k, "\< of the \>", 
          rows*cols, "\< elements of B are now converted to 0.\>"];\), 
      "\[IndentingNewLine]"}], "\[IndentingNewLine]", 
    RowBox[{
      RowBox[{"newB", "=", 
        StyleBox[\(Comp[B, k]\),
          FontColor->RGBColor[0.501961, 0, 0]]}], 
      StyleBox[";",
        FontColor->RGBColor[0.501961, 0, 
        0]]}], "\[IndentingNewLine]", }], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell["Now we Huffman encode the modified transform.", "Subsubtitle"],

Cell[BoxData[{
    \(\({codes, bitstream, encodestream} = 
        MakeHuffmanCodes[newB];\)\), "\[IndentingNewLine]", 
    \(\(bpp\  = \ 
        N[encodestream/\((rows*cols)\)];\)\), "\[IndentingNewLine]", 
    \(\(Print["\<The length of the encoded bit stream is \>", 
        encodestream, "\< or \>", bpp, "\< bpp!\>"];\)\)}], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell["\<\
If we compute the inverse transform, we can see the uncompressed image.  We \
plot the original for comparative purposes.\
\>", "Subsubtitle"],

Cell[BoxData[{
    RowBox[{
      RowBox[{"compressedA", " ", "=", " ", 
        StyleBox[\(IWT2D[newB, {1, 1}, NumIterations \[Rule] its]\),
          FontColor->RGBColor[0.501961, 0, 0]]}], 
      StyleBox[";",
        FontColor->RGBColor[0.501961, 0, 0]]}], "\[IndentingNewLine]", 
    StyleBox[\(ImagePlot[compressedA, 
          PlotLabel -> "\<Uncompressed Image\>"];\),
      FontColor->RGBColor[0.501961, 0, 0]], "\[IndentingNewLine]", 
    StyleBox[\(ImagePlot[A, PlotLabel -> "\<Original Image\>"];\),
      FontColor->RGBColor[0.501961, 0, 0]]}], "Input"],

Cell["To Consider ...", "Section"]
}, Open  ]],

Cell["\<\
1) What happens if you increase the number of iterations?  

2) What happens if you increase/decrease the energy level p?

3) Pick an image and then set its and p so that the encoded bit stream \
results in a compression rate of .5 bpp.  How does the uncompressed image \
look?\
\>", "Subsubtitle"]
}, Open  ]]
},
FrontEndVersion->"5.2 for Microsoft Windows",
ScreenRectangle->{{0, 1024}, {0, 695}},
WindowSize->{1016, 651},
WindowMargins->{{0, Automatic}, {Automatic, 0}},
ShowSelection->True
]

(*******************************************************************
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, 51, "Subtitle"],
Cell[1821, 55, 109, 4, 70, "Subsubtitle"],
Cell[1933, 61, 28, 0, 73, "Section"],

Cell[CellGroupData[{
Cell[1986, 65, 140, 3, 30, "Subsubtitle"],
Cell[2129, 70, 30, 0, 73, "Section"]
}, Open  ]],

Cell[CellGroupData[{
Cell[2196, 75, 1184, 28, 172, "Subsubtitle"],

Cell[CellGroupData[{
Cell[3405, 107, 40, 0, 73, "Section"],
Cell[3448, 109, 106, 2, 50, "Input"]
}, Open  ]],
Cell[3569, 114, 31, 0, 73, "Section"]
}, Open  ]],

Cell[CellGroupData[{
Cell[3637, 119, 133, 3, 30, "Subsubtitle"],
Cell[3773, 124, 118, 2, 50, "Input"],
Cell[3894, 128, 35, 0, 73, "Section"]
}, Open  ]],

Cell[CellGroupData[{
Cell[3966, 133, 400, 8, 71, "Subsubtitle"],
Cell[4369, 143, 1141, 21, 270, "Input"],
Cell[5513, 166, 34, 0, 73, "Section"]
}, Open  ]],

Cell[CellGroupData[{
Cell[5584, 171, 282, 5, 50, "Subsubtitle"],
Cell[5869, 178, 1035, 22, 190, "Input"],
Cell[6907, 202, 35, 0, 73, "Section"]
}, Open  ]],

Cell[CellGroupData[{
Cell[6979, 207, 230, 4, 50, "Subsubtitle"],
Cell[7212, 213, 1633, 37, 190, "Input"]
}, Open  ]],

Cell[CellGroupData[{
Cell[8882, 255, 426, 10, 231, "Subsubtitle"],
Cell[9311, 267, 32, 0, 73, "Section"]
}, Open  ]],

Cell[CellGroupData[{
Cell[9380, 272, 46, 0, 30, "Subsubtitle"],
Cell[9429, 274, 743, 15, 130, "Input"],
Cell[10175, 291, 48, 0, 73, "Section"]
}, Open  ]],

Cell[CellGroupData[{
Cell[10260, 296, 51, 0, 30, "Subsubtitle"],
Cell[10314, 298, 522, 11, 70, "Input"],
Cell[10839, 311, 39, 0, 73, "Section"]
}, Open  ]],

Cell[CellGroupData[{
Cell[10915, 316, 154, 3, 30, "Subsubtitle"],
Cell[11072, 321, 698, 13, 110, "Input"],
Cell[11773, 336, 33, 0, 73, "Section"]
}, Open  ]],

Cell[CellGroupData[{
Cell[11843, 341, 177, 5, 70, "Subsubtitle"],
Cell[12023, 348, 36, 0, 73, "Section"]
}, Open  ]],

Cell[CellGroupData[{
Cell[12096, 353, 258, 4, 50, "Subsubtitle"],
Cell[12357, 359, 36, 0, 73, "Section"]
}, Open  ]],

Cell[CellGroupData[{
Cell[12430, 364, 406, 9, 90, "Subsubtitle"],
Cell[12839, 375, 306, 8, 50, "Input"]
}, Open  ]],

Cell[CellGroupData[{
Cell[13182, 388, 204, 4, 50, "Subsubtitle"],
Cell[13389, 394, 646, 14, 110, "Input"],
Cell[14038, 410, 53, 0, 73, "Section"]
}, Open  ]],

Cell[CellGroupData[{
Cell[14128, 415, 593, 13, 70, "Subsubtitle"],
Cell[14724, 430, 423, 9, 70, "Input"]
}, Open  ]],

Cell[CellGroupData[{
Cell[15184, 444, 144, 5, 30, "Subsubtitle"],
Cell[15331, 451, 369, 8, 90, "Input"]
}, Open  ]],

Cell[CellGroupData[{
Cell[15737, 464, 772, 20, 110, "Subsubtitle"],
Cell[16512, 486, 120, 2, 30, "Input"]
}, Open  ]],

Cell[CellGroupData[{
Cell[16669, 493, 275, 6, 50, "Subsubtitle"],
Cell[16947, 501, 397, 9, 50, "Input"],
Cell[17347, 512, 36, 0, 73, "Section"]
}, Open  ]],

Cell[CellGroupData[{
Cell[17420, 517, 314, 7, 90, "Subsubtitle"],
Cell[17737, 526, 1223, 26, 190, "Input"]
}, Open  ]],

Cell[CellGroupData[{
Cell[18997, 557, 240, 4, 50, "Subsubtitle"],
Cell[19240, 563, 1412, 35, 230, "Input"]
}, Open  ]],

Cell[CellGroupData[{
Cell[20689, 603, 68, 0, 30, "Subsubtitle"],
Cell[20760, 605, 340, 6, 70, "Input"]
}, Open  ]],

Cell[CellGroupData[{
Cell[21137, 616, 152, 3, 30, "Subsubtitle"],
Cell[21292, 621, 566, 11, 70, "Input"],
Cell[21861, 634, 34, 0, 73, "Section"]
}, Open  ]],
Cell[21910, 637, 308, 8, 130, "Subsubtitle"]
}, Open  ]]
}
]
*)



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