Intitialization

displayToNotebook[graphic_, 
        opts___] := 
(nb = 
          NotebookCreate[WindowSize -> {350, 350}, 
            WindowFrame -> "Palette"]; 
        NotebookWrite[nb, 
          Cell[GraphicsData["PostScript", 
              DisplayString[graphic]], "Graphics", 
            DisplayFunction -> $DisplayFunction, opts]]; 
        graphic)

opts1 = 
      Sequence /@ {Frame -> False, Mesh -> False, 
          DisplayFunction -> Identity}

opts2 = 
      Sequence /@ {Frame -> False, Mesh -> False}

Reading and Displaying Graphics

Reading a graphic file

The new Import command provides Mathematica users with an efficient and intuitive way to read files in most standard graphics formats. Notice that MAthematica automatically detects the correct graphics format (JPEG).

cat  =  
        Import["C:\\WINDOWS\\Desktop\\Downloads\\gypsy.jpg"];

The imported graphics can be viewed immediately using Show.

Show[cat];

Accessing the underlying data set

The imported graphics file is of course represented by a Graphics object in Mathematica.

Head[cat]

To access and manipulate the data, we change the graphic to a list object.

cat  = cat /. Raster -> List;

This list consists of a number of elements. First off all, the graphics information and a display option.

Length[cat]

{Short[cat[[1]]], cat[[2]]}

The intererresting part is of course the array of color values, cat[[1,1]]

rasterdata  =  cat[[1, 1]];

To speed calculations up a bit, let's downsample the dataset by a factor of 4 by only taking every second element in both dimensions

rasterhalf = Take[rasterdata, {1, 266, 2}, {1, 276, 2}];

If we look at the dimensions of rasterhalf, we see that the colors are represented by RGB triples, so the dimensions of the data array is 133x138x3.

Dimensions[rasterhalf]

The new list selection command All makes it easy to extract just one color map, for example the red channel.

ListDensityPlot[rasterhalf[[All, All, 1]]/256, 
        AspectRatio -> 1,  Mesh -> False];

In the following graphic, a different color scheme is use to signify the channels.

Show[
        GraphicsArray[{ListDensityPlot[rasterhalf[[All, All, 1]]/256, 
              AspectRatio -> 1, 
              ColorFunction -> (RGBColor[#, 0, 0] &), opts1], 
            ListDensityPlot[rasterhalf[[All, All, 2]]/256, 
              AspectRatio -> 1, 
              ColorFunction -> (RGBColor[0, #, 0] &), opts1], 
            ListDensityPlot[rasterhalf[[All, All, 3]]/256, 
              AspectRatio -> 1, 
              ColorFunction -> (RGBColor[0, 0, #] &), opts1]}], 
        AspectRatio -> Automatic, 
        DisplayFunction -> $DisplayFunction];

Simple Math

Because the graphic data was converted to a Mathematica list, it can be manipulated using  standard Mathematica functions. Here the values get inverted to show the negative of the image.

ListDensityPlot[-rasterhalf[[All, All, 1]], 
      AspectRatio -> 1, opts2]

Calculating the square of all datapoints increases the contrast.

ListDensityPlot[rasterhalf[[All, All, 1]]^2, AspectRatio -> 1, 
      opts2]

Using higher powers emphasizes contrasts even more. Note that Mathematica still displays the image without the need to renormalize. The minimum color values is now 0, the maximum is (256^5)or 1099511627776.

ListDensityPlot[rasterhalf[[All, All, 1]]^5, AspectRatio -> 1, 
      opts2]

Taking the root of the color values deminished the contrast.

ListDensityPlot[Sqrt[rasterhalf[[All, All, 1]]], 
      AspectRatio -> 1, opts2]

ListDensityPlot[rasterhalf[[All, All, 1]]^(1/5), 
      AspectRatio -> 1, opts2]

Distortions and Rotations

Of course most image processing functions can be applied to discrete datasets, but in some cases, mathematical operations are much easier on continous data. Therefor, one can use ListInterpolate to generate a smooth interpolation over the whole discrete dataset. List interpolation in Mathematica is fast enough to make this task trivial.

interpol = 
          ListInterpolation[
            rasterhalf[[All, All, 1]], {{0, 1}, {0, 1}}]; // 
      Timing

The interpolation function can be used like any other Mathematica function, for example to distort the image by 'stretching the canvas'.

DensityPlot[interpol[Sqrt[x], Sqrt[y]], {y, 0, 1}, {x, 0, 1}, 
      PlotPoints -> 132, Mesh -> False, 
      Frame -> False]

Other mathematical functions generate diffeent distortion of the original image.

DensityPlot[
        Evaluate[interpol[ (((x + y))/2), y]], {y, 0, 1}, {x, 0, 1}, 
        PlotPoints -> 133, Mesh -> False, 
        Frame -> False];

interpol = 
      ListInterpolation[
        rasterhalf[[All, All, 1]], {{-2.1, 2.1}, {-2.1, 
            2.1}}]

In the following calculation, we use a rotation matrix to distort the image by rotating the 'pixels' according to their distance from the center.

DensityPlot[
      interpol[x Cos[(Sqrt[((x^2)/16) + ((y^2)/16)])] + 
          y Sin[(Sqrt[((x^2)/16) + ((y^2)/16)])], 
        y Cos[(Sqrt[((x^2)/16) + ((y^2)/16)])] - 
          x Sin[(Sqrt[((x^2)/16) + ((y^2)/16)])]], {y, -2, 2}, {x, -2, 2}, 
      PlotPoints -> 133, Mesh -> False, 
      Frame -> False]

Using List Interpolation to Visualize Color Levels

<< RealTime3D`

interpol = 
        ListInterpolation[
          rasterhalf[[All, All, 1]], {{0, 1}, {0, 1}}];

Plot3D[interpol[x, y], {x, 0, 1}, {y, 0, 1}, PlotPoints -> 133, 
        Boxed -> False,  Mesh -> False];

Now that we have a spline interpolation over the whole graphics set, doing operations like edge detection via differentiation is trivial.

DensityPlot[Evaluate[D[interpol[x, y], x]], {y, 0, 1}, {x, 0, 1}, 
        PlotPoints -> {133, 138}, Mesh -> False, 
        Frame -> False];

DensityPlot[Evaluate[D[interpol[x, y], y]], {y, 0, 1}, {x, 0, 1}, 
        PlotPoints -> {133, 138}, Mesh -> False, 
        Frame -> False];

DensityPlot[Evaluate[D[interpol[x, y], x]], {y, 0, 1}, {x, 0, 1}, 
        PlotPoints -> {133, 138}, Mesh -> False, 
        Frame -> False];

Data reconstruction via interpolation

Now lets cut down the number of data points significantly by looking just at the right eye, to show how interpolation can recover features.

righteye = Take[rasterhalf, {70, 90, 1}, {65, 80, 1}][[All, 
            All, 1]];

ListDensityPlot[righteye, opts2]

The picture above shows all the datapoints available. We can enhance this image by first interpolating tha values and then increasing the resolution of the plot of the smooth interpolation.

inter1  =  
        ListInterpolation[righteye, {{0, 1}, {0, 1}}, 
          InterpolationOrder -> 1];

DensityPlot[inter1[y, x], {x, 0, 1}, {y, 0, 1}, 
        PlotPoints -> 50, Mesh -> False, 
        Frame -> False];

Higher interpolation orders recover even more features.

inter3  =  
        ListInterpolation[righteye, {{0, 1}, {0, 1}}, 
          InterpolationOrder -> 3];

DensityPlot[inter3[y, x], {x, 0, 1}, {y, 0, 1}, 
        PlotPoints -> 50, Mesh -> False, 
        Frame -> False];

DensityPlot[inter3[y, x], {x, 0, 1}, {y, 0, 1}, 
        PlotPoints -> 100, Mesh -> False, 
        Frame -> False];