Discrete Wavelets with Applications

062 - 1D Haar Wavelet Transform

Helmut  Knaust - Department of Mathematical Sciences, University of Texas at El Paso, hknaust@utep.edu
03/25/2009. Last edits: 10/19/2023..

The Haar matrix as a combination of a low pass and a high pass filter

SetDirectory[NotebookDirectory[]];
<<DW.wl

?Haar

Normal[Haar[8]]

The reason for the names “low-pass filter” and “high-pass filter”:

Haar[8].{1,1,1,1,1,1,1,1}

Haar[8].{1,-1,1,-1,1,-1,1,-1}

Applying the Haar Wavelet Transform

Let' s start with a vector of length 512:

a=Table[Round[128+128Cos[29(1-x)^2]],{x,0,.99999,1/512}];
Grid[{{ListPlot[a,ImageSize->400,PlotRange->All],CEnergy[a,PlotLabel->StringForm["Entropy: ``",ShannonEntropy[a]],ImageSize->400]}}]

Normal[Haar[8]]

Applying the Haar transform :

b=Haar[512].a;
Grid[{{ListPlot[b,ImageSize->400,PlotRange->All],CEnergy[b,PlotLabel->StringForm["Entropy: ``",ShannonEntropy[b]],ImageSize->400]}}]

Applying the Haar transform again :

c=Join[Haar[256].b[[1;;256]],b[[257;;512]]];
Grid[{{ListPlot[c,ImageSize->400,PlotRange->All],CEnergy[c,PlotLabel->StringForm["Entropy: ``",ShannonEntropy[c]],ImageSize->400]}}]

... and a third time ....

d=Join[Haar[128].c[[1;;128]],c[[129;;512]]];
Grid[{{ListPlot[d,ImageSize->400,PlotRange->All],CEnergy[d,PlotLabel->StringForm["Entropy: ``",ShannonEntropy[d]],ImageSize->400]}}]

“Lossless” Compression: Retrieving the Original Vector

We are rounding the last vector to the nearest integer, and then apply the inverse Haar transform three times :

d=Round[d];
c1=Join[Transpose[Haar[128]].d[[1;;128]],d[[129;;512]]];
Grid[{{ListPlot[c1,ImageSize->400,PlotRange->All],CEnergy[c1,PlotLabel->StringForm["Entropy: ``",ShannonEntropy[c1]],ImageSize->400]}}]

b1=Join[Transpose[Haar[256]].c1[[1;;256]],c1[[257;;512]]];
Grid[{{ListPlot[b1,ImageSize->400,PlotRange->All],CEnergy[b1,PlotLabel->StringForm["Entropy: ``",ShannonEntropy[b1]],ImageSize->400]}}]

a1=Transpose[Haar[512]].b1;
a1=Round[a1];
Grid[{{ListPlot[a1,ImageSize->400,PlotRange->All],CEnergy[a1,PlotLabel->StringForm["Entropy: ``",ShannonEntropy[a1]],ImageSize->400]}}]

Here is a plot of the difference between the last vector and the original vector :

ListPlot[Abs[a-a1],ImageSize->400,PlotRange->All]

err=Total[(a1-a)^2]/512.;
10 Log[10,255^2/err]

Quantizing the Transformed Vector

To perform a lossy compression, let' s apply the Haar transform three times again, round off the entries, then replace all entries  in the transformed vector between - 15 and 15 by 0:

d=Round[d];
dq=d/.Table[i->0,{i,-15,15}];
Grid[{{ListPlot[dq,ImageSize->400,PlotRange->All],CEnergy[dq,PlotLabel->StringForm["Entropy: ``",ShannonEntropy[dq]],ImageSize->400]}}]

Applying the inverse Haar transform three times :

cq=Join[Transpose[Haar[128]].dq[[1;;128]],dq[[129;;512]]];
ListPlot[cq,ImageSize->400,PlotRange->All]

bq=Join[Transpose[Haar[256]].cq[[1;;256]],cq[[257;;512]]];
ListPlot[bq,ImageSize->400,PlotRange->All]

aq=Transpose[Haar[512]].bq;
aq=Round[aq];
ListPlot[aq,ImageSize->400,PlotRange->All]

Here is a plot of the absolute difference between the last vector and the original vector :

ListPlot[Abs[aq-a],PlotStyle->AbsoluteThickness[3],ImageSize->400,PlotRange->All]

err=Total[(aq-a)^2]/512.;
10 Log[10,255^2/err]