(* Content-type: application/mathematica *) (*** Wolfram Notebook File ***) (* http://www.wolfram.com/nb *) (* CreatedBy='Mathematica 6.0' *) (*CacheID: 234*) (* Internal cache information: NotebookFileLineBreakTest NotebookFileLineBreakTest NotebookDataPosition[ 145, 7] NotebookDataLength[ 30293, 994] NotebookOptionsPosition[ 27379, 897] NotebookOutlinePosition[ 27818, 914] CellTagsIndexPosition[ 27775, 911] WindowFrame->Normal ContainsDynamic->False*) (* Beginning of Notebook Content *) Notebook[{ Cell[CellGroupData[{ Cell["Haar Image Compression", "Title"], Cell["\<\ David Ruch and Patrick J. Van Fleet Minicourse #4, January 2008 Joint Mathematics Meetings San Diego, CA\ \>", "Subsubtitle", CellChangeTimes->{{3.408567721125*^9, 3.408567724*^9}, {3.40865760584375*^9, 3.408657615953125*^9}}], Cell[CellGroupData[{ Cell["Objective", "Section"], Cell["\<\ In this notebook, we will learn how to perform naive image compression using \ the 2D Haar Wavelet Transform.\ \>", "Text"] }, Open ]], Cell[CellGroupData[{ Cell["Conventions", "Section"], Cell[TextData[{ "This notebook uses the package ", StyleBox["DiscreteWavelets", FontColor->RGBColor[1, 0, 0]], " (written by Patrick Van Fleet). All commands from the ", StyleBox["DiscreteWavelets", FontColor->RGBColor[1, 0, 0]], " library will be denoted in ", StyleBox["red", FontColor->RGBColor[1, 0, 0]], ". Help is available for every command in ", StyleBox["the package", FontColor->GrayLevel[0]], ". Click on Help and then Documentation Center. At the bottom-right of the \ page is a link for Installed AddOns. Click this link and one of the options \ is DiscreteWavelets. Click this link to go to the Help Browser. 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\nComments are useful within cells of code. Any code enclosed \ by (* *) is a comment and ignored by the ", StyleBox["Mathematica", FontSlant->"Italic"], " kernel." }], "Text", CellChangeTimes->{{3.4085631561875*^9, 3.408563201375*^9}, { 3.4085632433125*^9, 3.408563315796875*^9}, {3.40856339940625*^9, 3.4085634034375*^9}, {3.408565167890625*^9, 3.40856516825*^9}}] }, Open ]], Cell[CellGroupData[{ Cell["Load DiscreteWavelets", "Section", CellChangeTimes->{3.408563584328125*^9}], Cell[BoxData[ RowBox[{"<<", "DiscreteWavelets`DiscreteWavelets`"}]], "Input", CellChangeTimes->{{3.408563455078125*^9, 3.408563467234375*^9}, { 3.408565207546875*^9, 3.40856520834375*^9}, {3.4085675625625*^9, 3.408567562828125*^9}}] }, Open ]], Cell[CellGroupData[{ Cell["Available Images", "Section", CellChangeTimes->{{3.408566424859375*^9, 3.40856642509375*^9}, { 3.40856666034375*^9, 3.40856666378125*^9}}], Cell[TextData[{ "The ", StyleBox["DiscreteWavelets", FontColor->RGBColor[1, 0, 0]], " packages comes with 18 grayscale images. You can see information about \ these images (name, size, etc.) by issuing the command ", StyleBox["ImageList", FontColor->RGBColor[1, 0, 0]], "." }], "Text", CellChangeTimes->{{3.40856643015625*^9, 3.408566482328125*^9}}], Cell[BoxData[ RowBox[{ StyleBox["ImageList", FontColor->RGBColor[1, 0, 0]], "[", RowBox[{"ImageType", "\[Rule]", "GrayScale"}], "]"}]], "Input", CellChangeTimes->{{3.408566491578125*^9, 3.40856650215625*^9}, { 3.408567558484375*^9, 3.408567558796875*^9}, {3.4085700635625*^9, 3.408570064296875*^9}}], Cell[TextData[{ "You can also get a look at these images by using the command ", StyleBox["ShowThumbnails", FontColor->RGBColor[1, 0, 0]], ". " }], "Text", CellChangeTimes->{{3.408635831734375*^9, 3.40863590271875*^9}}], Cell[BoxData[ RowBox[{ StyleBox["ShowThumbnails", FontColor->RGBColor[1, 0, 0]], "[", RowBox[{"ImageType", "\[Rule]", "GrayScale"}], "]"}]], "Input", CellChangeTimes->{{3.408635905203125*^9, 3.408635912609375*^9}}], Cell[TextData[{ StyleBox["NOTE:", FontWeight->"Bold"], " In ", StyleBox["Mathematica", FontSlant->"Italic"], " 5.2, ShowThumbnails does not exist - use the following command." }], "Text", CellChangeTimes->{{3.408635831734375*^9, 3.408635924390625*^9}, { 3.40863602578125*^9, 3.408636028421875*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ StyleBox["ImageNames", FontColor->RGBColor[1, 0, 0]], "[", RowBox[{ RowBox[{"ImageType", "\[Rule]", "GrayScale"}], ",", RowBox[{"Thumbnails", "\[Rule]", "True"}]}], "]"}], ";"}]], "Input", CellChangeTimes->{{3.408635940671875*^9, 3.4086359565625*^9}}], Cell[TextData[{ "No matter where you installed the ", StyleBox["DiscreteWavelets", FontColor->RGBColor[1, 0, 0]], " package on your computer, you can retrieve the absolute path and file name \ for each included image. The command ", StyleBox["ImageNames", FontColor->RGBColor[1, 0, 0]], " produces a list of file names. We will add a second directive to the call \ so that the routine will use smaller versions of the image." }], "Text", CellChangeTimes->{{3.40856651390625*^9, 3.408566597796875*^9}, { 3.408568365765625*^9, 3.408568388078125*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{"gray", "=", RowBox[{ StyleBox["ImageNames", FontColor->RGBColor[1, 0, 0]], "[", RowBox[{ RowBox[{"ImageType", "\[Rule]", "GrayScale"}], ",", RowBox[{"ListThumbnails", "\[Rule]", "True"}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{"gray", "[", RowBox[{"[", "1", "]"}], "]"}]}], "Input", CellChangeTimes->{{3.40856660190625*^9, 3.40856662253125*^9}, { 3.408567556296875*^9, 3.4085675565625*^9}, {3.4085683919375*^9, 3.408568396140625*^9}, {3.408570066625*^9, 3.408570067*^9}}] }, Open ]], Cell[CellGroupData[{ Cell["Loading and Plotting Images", "Section", CellChangeTimes->{{3.40856667084375*^9, 3.40856669671875*^9}}], Cell["\<\ Once you have the list of file names, it is very easy to load and plot \ images. Let's load the first image in the list.\ \>", "Text", CellChangeTimes->{{3.408566678375*^9, 3.408566710125*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{"A", "=", RowBox[{ StyleBox["ImageRead", FontColor->RGBColor[1, 0, 0]], "[", RowBox[{"gray", "[", RowBox[{"[", "1", "]"}], "]"}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ StyleBox["ImagePlot", FontColor->RGBColor[1, 0, 0]], "[", "A", "]"}]}], "Input", CellChangeTimes->{{3.408566701640625*^9, 3.408566736734375*^9}, { 3.408567553625*^9, 3.408567553875*^9}, {3.4085700694375*^9, 3.408570069765625*^9}}] }, Open ]], Cell[CellGroupData[{ Cell["Compute the Wavelet Transform", "Section"], Cell[TextData[{ "We first compute the 2D HWT. Since we are interested in compression, we \ will use a modified version of the Haar transformation. We will multiply the \ Haar matrix by Sqrt[2] so that the output are integers. Since we are not \ using the Haar filter per se, we will use the more general DiscreteWavelets \ routine ", StyleBox["WT2D", FontColor->RGBColor[1, 0, 0]], ". This routine requires three arguments. The first is the input matrix, \ the second is the filter used to construct the wavelet matrix, and the third \ is the number of iterations." }], "Text", CellChangeTimes->{{3.408568027328125*^9, 3.408568138796875*^9}}], Cell[BoxData[{ StyleBox[ RowBox[{ RowBox[{"its", "=", "2"}], ";"}], FontColor->GrayLevel[0]], "\[IndentingNewLine]", RowBox[{ RowBox[{"h", "=", RowBox[{ RowBox[{"Sqrt", "[", "2", "]"}], "*", RowBox[{ StyleBox["Haar", FontColor->RGBColor[1, 0, 0]], "[", "]"}]}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"B", " ", "=", " ", RowBox[{ StyleBox["WT2D", FontColor->RGBColor[1, 0, 0]], StyleBox["[", FontColor->GrayLevel[0]], StyleBox[ RowBox[{"A", ",", "h", ",", RowBox[{"NumIterations", "\[Rule]", "its"}]}], FontColor->GrayLevel[0]], StyleBox["]", FontColor->GrayLevel[0]]}]}], StyleBox[";", FontColor->GrayLevel[0]]}], "\[IndentingNewLine]", RowBox[{ StyleBox["WaveletDensityPlot", FontColor->RGBColor[1, 0, 0]], StyleBox["[", FontColor->GrayLevel[0]], StyleBox[ RowBox[{"B", ",", RowBox[{"NumIterations", "\[Rule]", "its"}]}], FontColor->GrayLevel[0]], StyleBox["]", FontColor->GrayLevel[0]]}]}], "Input", CellChangeTimes->{{3.408567932203125*^9, 3.408568008765625*^9}, 3.4085681608125*^9, 3.4085684340625*^9, {3.408569497515625*^9, 3.40856950015625*^9}, {3.40857007240625*^9, 3.408570072671875*^9}}] }, Open ]], Cell[CellGroupData[{ Cell["Lossless Compression", "Section"], Cell[TextData[{ "In this form of compression, we simply encode the transform. The image can \ be recovered exactly in lossless compression. We use the function ", StyleBox["MakeHuffmanCodes", FontColor->RGBColor[1, 0, 0]], " from ", StyleBox["DiscreteWavelets", FontColor->RGBColor[1, 0, 0]], " to build the codes. The routine requires nonnegative integers." }], "Text", CellChangeTimes->{{3.408568464203125*^9, 3.408568503859375*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"rows", ",", "cols"}], "}"}], "=", RowBox[{"Dimensions", "[", "A", "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"codes", ",", "totalbits", ",", "encodedbits"}], "}"}], "=", RowBox[{ StyleBox["MakeHuffmanCodes", FontColor->RGBColor[1, 0, 0]], "[", RowBox[{"Round", "[", RowBox[{"B", "-", RowBox[{"Min", "[", "B", "]"}]}], "]"}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"bpp", " ", "=", " ", RowBox[{ RowBox[{"N", "[", "encodedbits", "]"}], "/", RowBox[{"(", RowBox[{"rows", "*", "cols"}], ")"}]}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"Print", "[", RowBox[{ "\"\\"", ",", "rows", ",", "\"\< x \>\"", ",", "cols", ",", "\"\< x 8 = \>\"", ",", "totalbits", ",", "\"\<.\>\""}], "]"}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"Print", "[", RowBox[{ "\"\\"", ",", "encodedbits", ",", "\"\< or \>\"", ",", "bpp", ",", "\"\< bpp.\>\""}], "]"}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"Print", "[", RowBox[{"\"\\"", ",", RowBox[{ RowBox[{"Round", "[", RowBox[{"10000", "*", RowBox[{"bpp", "/", "8"}]}], "]"}], "/", "100."}], ",", "\"\<% of the original bitstream length.\>\""}], "]"}], ";"}]}], "Input", CellChangeTimes->{{3.408568228125*^9, 3.4085682296875*^9}, { 3.408568885640625*^9, 3.4085688964375*^9}, {3.408570075828125*^9, 3.40857007615625*^9}, {3.408676687734375*^9, 3.408676693*^9}}] }, Open ]], Cell[CellGroupData[{ Cell["To Consider...", "Section"], Cell["\<\ 1) What happens if we increase the number of iterations? 2) Try lossless compression with different images and different numbers of \ iterations.\ \>", "Text"] }, Open ]], Cell[CellGroupData[{ Cell["Lossy Compression", "Section"], 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.\ \>", "Text"] }, Open ]], Cell[CellGroupData[{ Cell["Cumulative Energy", "Section"], Cell[TextData[{ "We will use cumulative energy to perform quantization. The command in ", StyleBox["DiscreteWavelets", FontColor->RGBColor[1, 0, 0]], " to compute the cumulative energy is ", StyleBox["CE", FontColor->RGBColor[1, 0, 0]], ". It takes either a vector or a matrix as input.\n\nHere is the cumulative \ energy vector for our original image." }], "Text", CellChangeTimes->{{3.408569215796875*^9, 3.408569218640625*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{"ceA", " ", "=", " ", RowBox[{ StyleBox["CE", FontColor->RGBColor[1, 0, 0]], StyleBox["[", FontColor->GrayLevel[0]], StyleBox["A", FontColor->GrayLevel[0]], StyleBox["]", FontColor->GrayLevel[0]]}]}], StyleBox[";", FontColor->RGBColor[0.501961, 0, 0]]}], "\[IndentingNewLine]", RowBox[{"ListPlot", "[", RowBox[{"ceA", ",", RowBox[{"PlotStyle", "\[Rule]", "Red"}]}], "]"}]}], "Input", CellChangeTimes->{ 3.408567646796875*^9, {3.408570090515625*^9, 3.40857009078125*^9}}], 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.\ \>", "Text"], Cell[BoxData[{ RowBox[{ RowBox[{"ceB", " ", "=", " ", RowBox[{ StyleBox["CE", FontColor->RGBColor[1, 0, 0]], StyleBox["[", FontColor->GrayLevel[0]], StyleBox["B", FontColor->GrayLevel[0]], StyleBox["]", FontColor->GrayLevel[0]]}]}], StyleBox[";", FontColor->GrayLevel[0]]}], "\[IndentingNewLine]", RowBox[{"plot", " ", "=", " ", RowBox[{"ListPlot", "[", RowBox[{"ceB", ",", RowBox[{"PlotStyle", "\[Rule]", "Blue"}]}], "]"}]}], "\[IndentingNewLine]", StyleBox[ RowBox[{ RowBox[{"i", "=", RowBox[{"rows", "*", RowBox[{"cols", "/", "8"}]}]}], ";"}], FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", RowBox[{ RowBox[{"pct", " ", "=", " ", RowBox[{ RowBox[{"Round", "[", RowBox[{ RowBox[{"ceB", "[", RowBox[{"[", "i", "]"}], "]"}], "*", "10000"}], "]"}], "/", "100."}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"Print", "[", RowBox[{ "pct", ",", "\"\< of the energy is stored in the largest (in absolute value) \>\"", ",", "i", ",", "\"\< elements of B.\>\""}], "]"}], ";"}]}], "Input", CellChangeTimes->{ 3.408567658890625*^9, {3.40857009271875*^9, 3.408570093*^9}}] }, Open ]], Cell[CellGroupData[{ Cell[" Quantizing with Cumulative Energy", "Section"], 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["DiscreteWavelets", FontColor->RGBColor[1, 0, 0]], " called ", StyleBox["nCE", FontColor->RGBColor[1, 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." }], "Text", CellChangeTimes->{{3.408569243609375*^9, 3.408569246203125*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{"p", "=", ".998"}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"k", "=", RowBox[{ StyleBox["nCE", FontColor->RGBColor[1, 0, 0]], StyleBox["[", FontColor->GrayLevel[0]], StyleBox[ RowBox[{"ceB", ",", "p"}], FontColor->GrayLevel[0]], StyleBox["]", FontColor->GrayLevel[0]]}]}], StyleBox[";", FontColor->GrayLevel[0]]}], "\[IndentingNewLine]", RowBox[{ RowBox[{"Print", "[", RowBox[{ "\"\\"", ",", "k", ",", "\"\< elements of B constitute \>\"", ",", RowBox[{"100", "*", "p"}], ",", "\"\<% of the energy of B.\>\""}], "]"}], ";"}]}], "Input", CellChangeTimes->{{3.408570096265625*^9, 3.408570096515625*^9}}], Cell[TextData[{ "Here is a graphical interpretation of ", StyleBox["nCE", FontColor->RGBColor[1, 0, 0]], "." }], "Text"], Cell[BoxData[{ RowBox[{ RowBox[{"line1", "=", RowBox[{"Graphics", "[", RowBox[{"{", RowBox[{"Red", ",", RowBox[{"Line", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"1", ",", "p"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"rows", "*", "cols"}], ",", "p"}], "}"}]}], "}"}], "]"}]}], "}"}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"line2", "=", RowBox[{"Graphics", "[", RowBox[{"{", RowBox[{"Green", ",", RowBox[{"Line", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"k", ",", RowBox[{"First", "[", "ceB", "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"k", ",", "1"}], "}"}]}], "}"}], "]"}]}], "}"}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{"Show", "[", RowBox[{ RowBox[{"{", RowBox[{"plot", ",", "line1", ",", "line2"}], "}"}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{".8", ",", "1"}], "}"}]}]}], "]"}], "\[IndentingNewLine]"}], "Input", CellChangeTimes->{ 3.408567684046875*^9, {3.408569294109375*^9, 3.40856937865625*^9}, { 3.408569511171875*^9, 3.40856951296875*^9}, {3.40857009971875*^9, 3.408570100015625*^9}}], Cell[TextData[{ "We next convert all but the largest (in absolute value) k values of B to 0. \ The module in ", StyleBox["DiscreteWavelets", FontColor->RGBColor[1, 0, 0]], " to perform this task is ", StyleBox["Comp", FontColor->RGBColor[1, 0, 0]], ". ", StyleBox["Comp", FontColor->RGBColor[1, 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[1, 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[1, 0, 0]], "." }], "Text", CellChangeTimes->{{3.40856940790625*^9, 3.40856941015625*^9}}], Cell[BoxData[ RowBox[{ StyleBox["Comp", FontColor->RGBColor[1, 0, 0]], StyleBox["[", FontColor->GrayLevel[0]], StyleBox[ RowBox[{ RowBox[{"{", RowBox[{"1", ",", RowBox[{"-", "2"}], ",", "3", ",", "4", ",", RowBox[{"-", "5"}]}], "}"}], ",", "3"}], FontColor->GrayLevel[0]], StyleBox["]", FontColor->GrayLevel[0]]}]], "Input", CellChangeTimes->{{3.40857010321875*^9, 3.408570103515625*^9}}], 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). " }], "Text", CellChangeTimes->{3.408675829125*^9}], Cell[BoxData[{ RowBox[{ RowBox[{"newB", "=", RowBox[{ StyleBox["Comp", FontColor->RGBColor[1, 0, 0]], StyleBox["[", FontColor->GrayLevel[0]], StyleBox[ RowBox[{"B", ",", "2500"}], FontColor->GrayLevel[0]], StyleBox["]", FontColor->GrayLevel[0]]}]}], StyleBox[";", FontColor->GrayLevel[0]]}], "\[IndentingNewLine]", RowBox[{ StyleBox["WaveletDensityPlot", FontColor->RGBColor[1, 0, 0]], StyleBox["[", FontColor->GrayLevel[0]], StyleBox[ RowBox[{"newB", ",", RowBox[{"NumIterations", "\[Rule]", "its"}]}], FontColor->GrayLevel[0]], StyleBox["]", FontColor->GrayLevel[0]]}]}], "Input", CellChangeTimes->{ 3.4085676899375*^9, {3.408569485625*^9, 3.40856948775*^9}, { 3.408570105671875*^9, 3.40857010596875*^9}}] }, Open ]], Cell[CellGroupData[{ Cell["Lossy Compression", "Section"], 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.\ \>", "Text"], Cell[BoxData[{ RowBox[{ RowBox[{"A", "=", RowBox[{ StyleBox["ImageRead", FontColor->RGBColor[1, 0, 0]], StyleBox["[", FontColor->GrayLevel[0]], StyleBox[ RowBox[{"gray", "[", RowBox[{"[", "1", "]"}], "]"}], FontColor->GrayLevel[0]], StyleBox["]", FontColor->GrayLevel[0]]}]}], StyleBox[";", FontColor->GrayLevel[0]]}], "\[IndentingNewLine]", RowBox[{ StyleBox["ImagePlot", FontColor->RGBColor[1, 0, 0]], StyleBox["[", FontColor->GrayLevel[0]], StyleBox["A", FontColor->GrayLevel[0]], StyleBox["]", FontColor->GrayLevel[0]]}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"rows", ",", "cols"}], "}"}], "=", RowBox[{"Dimensions", "[", "A", "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"Print", "[", RowBox[{"\"\\"", ",", RowBox[{"rows", "*", "cols", "*", "8"}], ",", "\"\<.\>\""}], "]"}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", StyleBox[ RowBox[{ RowBox[{"its", "=", "3"}], ";"}], FontColor->GrayLevel[0]], "\[IndentingNewLine]", StyleBox[ RowBox[{ RowBox[{"h", "=", RowBox[{ RowBox[{"Sqrt", "[", "2", "]"}], "*", RowBox[{"Haar", "[", "]"}]}]}], ";"}], FontColor->GrayLevel[0]], "\[IndentingNewLine]", RowBox[{ RowBox[{"B", "=", RowBox[{ StyleBox["WT2D", FontColor->RGBColor[1, 0, 0]], StyleBox["[", FontColor->GrayLevel[0]], StyleBox[ RowBox[{"A", ",", "h", ",", RowBox[{"NumIterations", "\[Rule]", "its"}]}], FontColor->GrayLevel[0]], StyleBox["]", FontColor->GrayLevel[0]]}]}], StyleBox[";", FontColor->GrayLevel[0]]}], "\[IndentingNewLine]", RowBox[{ StyleBox["WaveletDensityPlot", FontColor->RGBColor[1, 0, 0]], StyleBox["[", FontColor->GrayLevel[0]], StyleBox[ RowBox[{"B", ",", RowBox[{"NumIterations", "\[Rule]", "its"}]}], FontColor->GrayLevel[0]], StyleBox["]", FontColor->GrayLevel[0]]}]}], "Input", CellChangeTimes->{{3.408569539859375*^9, 3.408569574734375*^9}, { 3.408569608609375*^9, 3.408569641796875*^9}, {3.408570111015625*^9, 3.408570111421875*^9}}], 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.\ \>", "Text"], Cell[BoxData[{ RowBox[{ RowBox[{ StyleBox["ceB", FontColor->GrayLevel[0]], StyleBox["=", FontColor->GrayLevel[0]], RowBox[{ StyleBox["CE", FontColor->RGBColor[1, 0, 0]], StyleBox["[", FontColor->GrayLevel[0]], StyleBox[ RowBox[{"N", "[", "B", "]"}], FontColor->GrayLevel[0]], StyleBox["]", FontColor->GrayLevel[0]]}]}], StyleBox[";", FontColor->GrayLevel[0]]}], "\[IndentingNewLine]", RowBox[{ RowBox[{"ListPlot", "[", RowBox[{"ceB", ",", RowBox[{"PlotStyle", "\[Rule]", "Blue"}]}], "]"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", StyleBox[ RowBox[{ RowBox[{"p", "=", ".9995"}], ";"}], FontColor->RGBColor[0, 0, 1]], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"k", "=", RowBox[{ StyleBox["nCE", FontColor->RGBColor[1, 0, 0]], StyleBox["[", FontColor->GrayLevel[0]], StyleBox[ RowBox[{"ceB", ",", "p"}], FontColor->GrayLevel[0]], StyleBox["]", FontColor->GrayLevel[0]]}]}], StyleBox[";", FontColor->GrayLevel[0]]}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"Print", "[", RowBox[{ "\"\\"", ",", "k", ",", "\"\< elements of B constitute \>\"", ",", RowBox[{ RowBox[{"Round", "[", RowBox[{"10000", "*", "p"}], "]"}], "/", "100."}], ",", "\"\<% of the energy of B.\>\""}], "]"}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"Print", "[", RowBox[{ RowBox[{ RowBox[{"rows", "*", "cols"}], "-", "k"}], ",", "\"\< of the \>\"", ",", RowBox[{"rows", "*", "cols"}], ",", "\"\< elements of B are now converted to 0.\>\""}], "]"}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"newB", "=", RowBox[{ StyleBox["Comp", FontColor->RGBColor[1, 0, 0]], StyleBox["[", FontColor->GrayLevel[0]], StyleBox[ RowBox[{"B", ",", "k"}], FontColor->GrayLevel[0]], StyleBox["]", FontColor->GrayLevel[0]]}]}], StyleBox[";", FontColor->GrayLevel[0]]}]}], "Input", CellChangeTimes->{ 3.40856771003125*^9, {3.40856967328125*^9, 3.408569674015625*^9}, { 3.40856984540625*^9, 3.408569845484375*^9}, {3.408569929984375*^9, 3.408569931796875*^9}, {3.408570116125*^9, 3.40857011640625*^9}}], Cell["Now we Huffman encode the modified transform.", "Text"], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"codes", ",", "bitstream", ",", "encodestream"}], "}"}], "=", RowBox[{ StyleBox["MakeHuffmanCodes", FontColor->RGBColor[1, 0, 0]], "[", RowBox[{"Round", "[", RowBox[{"newB", "-", RowBox[{"Min", "[", "newB", "]"}]}], "]"}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"bpp", " ", "=", " ", RowBox[{"N", "[", RowBox[{"encodestream", "/", RowBox[{"(", RowBox[{"rows", "*", "cols"}], ")"}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"Print", "[", RowBox[{ "\"\\"", ",", "encodestream", ",", "\"\< or \>\"", ",", "bpp", ",", "\"\< bpp!\>\""}], "]"}], ";"}]}], "Input", CellChangeTimes->{{3.408569706046875*^9, 3.408569713390625*^9}, { 3.408570132609375*^9, 3.408570132890625*^9}}], Cell["\<\ If we compute the inverse transform, we can see the uncompressed image. We \ plot the original for comparative purposes. Note that we have to divide our \ filter now by Sqrt[2].\ \>", "Text", CellChangeTimes->{{3.408569761703125*^9, 3.40856977325*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{"h", "=", RowBox[{ RowBox[{"Haar", "[", "]"}], "/", RowBox[{"Sqrt", "[", "2", "]"}]}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"compressedA", " ", "=", " ", RowBox[{ StyleBox["IWT2D", FontColor->RGBColor[1, 0, 0]], StyleBox["[", FontColor->GrayLevel[0]], StyleBox[ RowBox[{"newB", ",", "h", ",", RowBox[{"NumIterations", "\[Rule]", "its"}]}], FontColor->GrayLevel[0]], StyleBox["]", FontColor->GrayLevel[0]]}]}], StyleBox[";", FontColor->GrayLevel[0]]}], "\[IndentingNewLine]", RowBox[{ StyleBox["ImagePlot", FontColor->RGBColor[1, 0, 0]], StyleBox["[", FontColor->GrayLevel[0]], StyleBox[ RowBox[{"compressedA", ",", RowBox[{"PlotLabel", "->", "\"\\""}]}], FontColor->GrayLevel[0]], StyleBox["]", FontColor->GrayLevel[0]]}], "\[IndentingNewLine]", RowBox[{ StyleBox["ImagePlot", FontColor->RGBColor[1, 0, 0]], StyleBox["[", FontColor->GrayLevel[0]], StyleBox[ RowBox[{"A", ",", RowBox[{"PlotLabel", "->", "\"\\""}]}], FontColor->GrayLevel[0]], StyleBox["]", FontColor->GrayLevel[0]]}]}], "Input", CellChangeTimes->{{3.408569780078125*^9, 3.4085698224375*^9}, { 3.408570134859375*^9, 3.4085701351875*^9}}] }, Open ]], Cell[CellGroupData[{ Cell["To Consider ...", "Section"], 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?\ \>", "Text"] }, Open ]] }, Open ]] }, WindowSize->{1272, 683}, WindowMargins->{{0, Automatic}, {Automatic, 0}}, ShowSelection->True, FrontEndVersion->"6.0 for Microsoft Windows (32-bit) (April 20, 2007)", StyleDefinitions->FrontEnd`FileName[{"Creative"}, "NaturalColor.nb", CharacterEncoding -> "WindowsANSI"] ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[590, 23, 39, 0, 73, "Title"], Cell[632, 25, 240, 6, 69, "Subsubtitle"], Cell[CellGroupData[{ Cell[897, 35, 28, 0, 75, "Section"], Cell[928, 37, 133, 3, 29, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[1098, 45, 30, 0, 75, "Section"], Cell[1131, 47, 1259, 28, 119, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[2427, 80, 82, 1, 75, "Section"], Cell[2512, 83, 239, 4, 41, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[2788, 92, 147, 2, 75, "Section"], Cell[2938, 96, 360, 10, 47, "Text"], Cell[3301, 108, 314, 7, 41, "Input"], Cell[3618, 117, 226, 6, 29, "Text"], Cell[3847, 125, 224, 5, 41, "Input"], Cell[4074, 132, 310, 9, 29, "Text"], Cell[4387, 143, 307, 8, 41, "Input"], Cell[4697, 153, 562, 12, 47, "Text"], Cell[5262, 167, 560, 14, 62, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[5859, 186, 110, 1, 75, "Section"], Cell[5972, 189, 205, 4, 29, "Text"], Cell[6180, 195, 480, 13, 62, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[6697, 213, 48, 0, 75, "Section"], Cell[6748, 215, 653, 12, 65, "Text"], Cell[7404, 229, 1253, 41, 102, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[8694, 275, 39, 0, 75, "Section"], Cell[8736, 277, 448, 10, 47, "Text"], Cell[9187, 289, 1718, 45, 142, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[10942, 339, 33, 0, 75, "Section"], Cell[10978, 341, 170, 5, 65, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[11185, 351, 36, 0, 75, "Section"], Cell[11224, 353, 251, 4, 47, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[11512, 362, 36, 0, 75, "Section"], Cell[11551, 364, 442, 10, 65, "Text"], Cell[11996, 376, 566, 18, 62, "Input"], Cell[12565, 396, 197, 4, 29, "Text"], Cell[12765, 402, 1224, 40, 122, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[14026, 447, 53, 0, 75, "Section"], Cell[14082, 449, 629, 14, 47, "Text"], Cell[14714, 465, 761, 24, 82, "Input"], Cell[15478, 491, 125, 5, 29, "Text"], Cell[15606, 498, 1298, 40, 102, "Input"], Cell[16907, 540, 773, 21, 83, "Text"], Cell[17683, 563, 440, 15, 41, "Input"], Cell[18126, 580, 238, 6, 29, "Text"], Cell[18367, 588, 803, 28, 62, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[19207, 621, 36, 0, 75, "Section"], Cell[19246, 623, 307, 7, 65, "Text"], Cell[19556, 632, 2228, 75, 202, "Input"], Cell[21787, 709, 233, 4, 29, "Text"], Cell[22023, 715, 2385, 80, 222, "Input"], Cell[24411, 797, 61, 0, 29, "Text"], Cell[24475, 799, 896, 26, 82, "Input"], Cell[25374, 827, 265, 5, 29, "Text"], Cell[25642, 834, 1334, 44, 102, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[27013, 883, 34, 0, 75, "Section"], Cell[27050, 885, 301, 8, 101, "Text"] }, Open ]] }, Open ]] } ] *) (* End of internal cache information *)