Discrete Wavelets

031a - Color Histogram Equalization

Helmut  Knaust - Department of Mathematical Sciences, University of Texas at El Paso, hknaust@utep.edu
02/17/2024.

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

Image Processing : Histogram Equalization

Let' s first look at the histogram of an image: a histogram lists the frequency with which every value between 0 and 255 shows up in the image:

pic=Import["Images\\Color\\facade_small.png","Data"];
ImagePlot[pic]
{r,g,b}=GrayChannels[pic];
ImagePlot[r]
ImagePlot[g]
ImagePlot[b]

Here is a slightly fancier version from the DW.m package :

FrequencyHistogram[r]
FrequencyHistogram[g]
FrequencyHistogram[b]

Let' s define T(k) next :

rf=Flatten[r];gf=Flatten[g];bf=Flatten[b];

tab=Accumulate[Table[Count[rf,i],{i,0,255}]]/Length[rf];
T[k_]:=N[tab[[k+1]]]
ListPlot[Table[{k,T[k]},{k,0,255}],ImageSize->700];

ListPlot[Table[{k,255T[k]},{k,0,255}],PlotStyle->{Blue,AbsoluteThickness[3]}, Joined->True,Epilog->{Dashed,Thick,Blue,Table[Line[{{k,0},{k,Round[255T[k]]},{0,Round[255T[k]]}}],{k,0,255,50}]},ImageSize->750,AxesLabel->{"Before Equalization","After Equalization"},BaseStyle->{Bold,14},PlotRange->{0,256}];

req=Round[255Map[T,r,{2}]];
ImagePlot[req,PlotLabel->"Equalized Image"]

tab=Accumulate[Table[Count[gf,i],{i,0,255}]]/Length[gf];
T[k_]:=N[tab[[k+1]]]
ListPlot[Table[{k,T[k]},{k,0,255}],ImageSize->700];

ListPlot[Table[{k,255T[k]},{k,0,255}],PlotStyle->{Blue,AbsoluteThickness[3]}, Joined->True,Epilog->{Dashed,Thick,Blue,Table[Line[{{k,0},{k,Round[255T[k]]},{0,Round[255T[k]]}}],{k,0,255,50}]},ImageSize->750,AxesLabel->{"Before Equalization","After Equalization"},BaseStyle->{Bold,14},PlotRange->{0,256}];

geq=Round[255Map[T,g,{2}]];
ImagePlot[geq,PlotLabel->"Equalized Image"]

tab=Accumulate[Table[Count[bf,i],{i,0,255}]]/Length[bf];
T[k_]:=N[tab[[k+1]]]
ListPlot[Table[{k,T[k]},{k,0,255}],ImageSize->700];

ListPlot[Table[{k,255T[k]},{k,0,255}],PlotStyle->{Blue,AbsoluteThickness[3]}, Joined->True,Epilog->{Dashed,Thick,Blue,Table[Line[{{k,0},{k,Round[255T[k]]},{0,Round[255T[k]]}}],{k,0,255,50}]},ImageSize->750,AxesLabel->{"Before Equalization","After Equalization"},BaseStyle->{Bold,14},PlotRange->{0,256}];

beq=Round[255Map[T,b,{2}]];
ImagePlot[beq,PlotLabel->"Equalized Image"]

ImagePlot[JoinGrayChannels[req,geq,beq]]

ImagePlot[pic]

ave=Round[1/3(r+g+b)];
avef=Flatten[ave];

ImagePlot[ave]

tab=Accumulate[Table[Count[avef,i],{i,0,255}]]/Length[avef];
T[k_]:=N[tab[[k+1]]]
ListPlot[Table[{k,T[k]},{k,0,255}],ImageSize->700];

ListPlot[Table[{k,255T[k]},{k,0,255}],PlotStyle->{Blue,AbsoluteThickness[3]}, Joined->True,Epilog->{Dashed,Thick,Blue,Table[Line[{{k,0},{k,Round[255T[k]]},{0,Round[255T[k]]}}],{k,0,255,50}]},ImageSize->750,AxesLabel->{"Before Equalization","After Equalization"},BaseStyle->{Bold,14},PlotRange->{0,256}];

aveeq=Round[255Map[T,ave,{2}]];
ImagePlot[aveeq,PlotLabel->"Equalized Image"]

chg=aveeq-ave;

rnew=Round[chg +r];
gnew=Round[chg +g];
bnew=Round[chg +b];

ImagePlot[JoinGrayChannels[rnew,gnew,bnew]]

ImagePlot[pic]