Fourier Theory and Fourier Transforms

Discrete Fourier Transforms on very simple lattices

Create a simple lattice to upon which a fourier transform will  taken

In[217]:=

WhiteSquare = Table[1, {i, 8}, {j, 8}] ;

BlackSquare = Table[0, {i, 8}, {j, 8}] ;

Join[WhiteSquare, BlackSquare, BlackSquare]//MatrixForm

Out[219]//MatrixForm=

Example of construction of a  slightly larger structure

In[220]:=

Visualize structure:

In[221]:=

ListDensityPlot[latcell, MeshStyle→ {Hue[1]}] ;

[Graphics:HTMLFiles/Lecture-18_7.gif]

The following duplicates an input matrix and creates 2^n copies alligned in a column:

In[222]:=

ColumnDuplicateNsq[matrix_ , nlog2_] := Nest[Join[#, #] &, matrix, nlog2]

example:

In[223]:=

ListDensityPlot[ColumnDuplicateNsq[latcell, 2], MeshStyle→ {Hue[1]}]

[Graphics:HTMLFiles/Lecture-18_11.gif]

Out[223]=

-DensityGraphics -

The following duplicates an input matrix and create 2^n copies alligned in a row

In[224]:=

RowDuplicateNsq[matrix_ , nlog2_] := Transpose[ColumnDuplicateNsq[matrix, nlog2]]

example:

In[225]:=

ListDensityPlot[RowDuplicateNsq[latcell, 2], MeshStyle→ {Hue[1]}]

[Graphics:HTMLFiles/Lecture-18_16.gif]

Out[225]=

-DensityGraphics -

Create a 256 by 256 data set

In[226]:=

XtalData = Transpose[ColumnDuplicateNsq[RowDuplicateNsq[latcell, 3], 3]] ;

Function to create graphics for delayed display

In[227]:=

DisplayLater = DisplayFunction→Identity ;

DisplayNow = DisplayFunction→ $DisplayFunction ;

In[229]:=

ImagePlot[data_ ] := ListDensityPlot[data, Mesh->False, ImageSize→144, DisplayLater]

Example

In[230]:=

XtalImage = ImagePlot[XtalData]

Out[230]=

-DensityGraphics -

To see the data:

In[231]:=

Show[XtalImage, DisplayNow, ImageSize→400]

[Graphics:HTMLFiles/Lecture-18_25.gif]

Out[231]=

-DensityGraphics -

Take Discrete Fourier Transform of constructed simple lattice

In[232]:=

FourierData = Fourier[XtalData] ;

Create Image of Fourier Transform (Here a special color function is used (but not really explained). Red is high intensity, blue is low, gray is roughly zero)
Abs is used to get intensities of spots at each of the N×M wavevectors

In[233]:=

FourierColorFunctionWhiteBack := ColorFunction→ (If[#<.05, Hue[1, 0, #], Hue[.66 * (1 - #), #, 1]] &) ;

FourierColorFunctionBlackBack := ColorFunction→ (If[#<.1, Hue[1, 0, 5 * #], Hue[.66 * (1 - #), .75 (1 + #/3), 1]] &) ;

FourierImagePlot[data_ ] := ListDensityPlot[Abs[data], Mesh->False, ImageSize→144, FourierColorFunctionBlackBack, DisplayLater]

In[236]:=

FourierImage = FourierImagePlot[FourierData]

Out[236]=

-DensityGraphics -

Show original,its Fourier Transform (FT), and the FT the  FT:
Use Chop to remove small spurious imaginary values.  Because the lattice is very perfect, the fourier spots are very small. One could use the magnification feature to improve the visibility of the spots.

In[237]:=

Show[GraphicsArray[{XtalImage, FourierImage, ImagePlot[Chop[InverseFourier[FourierData]]]}], ImageSize→1000, DisplayNow]

[Graphics:HTMLFiles/Lecture-18_34.gif]

Out[237]=

-GraphicsArray -

Some notes on the plots above: The spot pattern in the Fourier transform extends over the entire pane but is hard to resolve except around the perimeter. Note periodic array of sharp spots in the Fourier transform, and note that there are some "missing" columns of spots that also repeat periodically. Note that the Fourier transform of the Fourier transform reconstructs the orignial object quite faithfully.

Microscopists are used to seeing the "k=0" point in the center of the fourier image (i.e., the periodic information at the center). We can write a function that translates the k=0 point to the center of the image and redisplay the result:

In[238]:=

<<LinearAlgebra`MatrixManipulation`

FourierImagePlot[data_ ] := ListDensityPlot[KZeroAtCenter[Abs[data]], Mesh->False, ImageSize→144, FourierColorFunctionBlackBack, DisplayLater]

FourierImage = FourierImagePlot[FourierData]

Show[GraphicsArray[{XtalImage, FourierImage, ImagePlot[Chop[InverseFourier[FourierData]]]}], ImageSize→1000, DisplayNow]

Out[241]=

-DensityGraphics -

[Graphics:HTMLFiles/Lecture-18_42.gif]

Out[242]=

-GraphicsArray -

Create a function to create a defect in the lattice...(there will be a small portion of the white rectangle at the lower left that is missing; otherwise the object will be the same as above).

In[243]:=

General :: spell1 : Possible spelling error: new symbol name \"nrows\" is similar to existing symbol \"rows\".  More…

General :: spell1 : Possible spelling error: new symbol name \"ncols\" is similar to existing symbol \"cols\".  More…

In[244]:=

XtalData = Transpose[ColumnDuplicateNsq[RowDuplicateNsq[latcell, 3], 3]] ;

Create template for defect creation

In[245]:=

hole = HoleFunc[XtalData, 28, 28, 6, 6] ;

Recreate Images and Redisplay

In[246]:=

XtalData = Transpose[ColumnDuplicateNsq[RowDuplicateNsq[latcell, 3], 3]] ;

XtalData = hole * XtalData ;

XtalImage = ImagePlot[XtalData] ;

FourierData = Fourier[XtalData] ;

FourierImage = FourierImagePlot[FourierData] ;

Note curious result that the position of the defect has changed to a symmetric position in the reconstructed image

In[251]:=

Show[GraphicsArray[{XtalImage, FourierImage, ImagePlot[Chop[InverseFourier[FourierData]]]}], ImageSize→1000, DisplayNow]

[Graphics:HTMLFiles/Lecture-18_55.gif]

Out[251]=

-GraphicsArray -

Note above that the Fourier transform continues to have the sharp spots associated with the perfect crystal, but that "diffuse" intensity (colored contours) now arises throughout reciprocal space.  The details of the diffuse intensity distribution contain information about the structure of the defect. Once again, except for orientation, the "backtransform" gives a very accurate reconstruction of the original.

Visualization of the Fourier Transform of a lattice that has a little "thermal" noise in the lattice positions

Function to make a square with a specified size, with a lattice composed of lattice vectors:
MakeLattice[Width, Height, {a_x, a_y, repeats}, {b_x, b_y, repeats}, AtomSize, {noise_back, noise_forward}]
Function is not ideal, works best when the lattice vectors are perfect divisors of the width and height

In[252]:=

General :: spell1 : Possible spelling error: new symbol name \"ypos\" is similar to existing symbol \"xpos\".  More…

General :: spell1 : Possible spelling error: new symbol name \"lata\" is similar to existing symbol \"data\".  More…

General :: spell1 : Possible spelling error: new symbol name \"latb\" is similar to existing symbol \"lata\".  More…

General :: stop : Further output of General :: spell1 will be suppressed during this calculation. More…

Example of a lattice with no noise:

In[253]:=

latdata = MakeLattice[400, 400, {0, 20, 40}, {16, 4, 25}, 4, {0, 0}] ; fourlat = Fourier[latdata] ;

In[254]:=

Show[GraphicsArray[{ImagePlot[latdata], FourierImagePlot[fourlat], ImagePlot[Chop[InverseFourier[fourlat]]]}], ImageSize→1000, DisplayNow]

[Graphics:HTMLFiles/Lecture-18_68.gif]

Out[254]=

-GraphicsArray -

Make identical lattice, but add a little noise to the system:

The noise is simulated by making small random displacements of each "atom" about its site in the perfect crystal, then computing the Fourier transform of the resulting somewhat imperfect crystal...

In[255]:=

thermallatdata = MakeLattice[400, 400, {0, 20, 40}, {16, 4, 25}, 4, {-2, 2}] ; thermalfourlat = Fourier[thermallatdata] ;

Visualization of the original image, its fourier transform, and them inverse fourier transform of the fourier transform..

In[256]:=

Show[GraphicsArray[{ImagePlot[thermallatdata], FourierImagePlot[thermalfourlat], ImagePlot[Chop[InverseFourier[thermalfourlat]]]}], ImageSize→1000, DisplayNow]

[Graphics:HTMLFiles/Lecture-18_72.gif]

Out[256]=

-GraphicsArray -

Notes on these images: The periodic array of spots seen in previous Fourier transforms from "crystals" are not visible here, but they are present. Once again, the imperfection of the object gives rise to a distribution of "diffuse" intensity in reciprocal space. Careful observation indicates that the back-transform on the right is rotated 180° with respect to the original, as in the example above that contained the single defect.

Using an Aperature to look at a particular region of reciprocal space and visualizing its effect

The following is a fairly baroque function to do something what is conceptually straightforward:
    The function takes original data from a lattice and its fourier transform and graphically compares those to data from a "noised-up" lattice.
        The function allows the user to specify the center of the aperature in reciprocal space as well as (twice) the aperature width and height.
        The function will display eight images in two columns. The left column of graphics illustrates (from top to bottom)the "clean" input image, the entire fourier transform with the rectangular aperature illustrated, the "reconstructed image" that derives from the fourier transform of the aperature region, and finally a magnified image of the fourier transform within the aperature only.
    The right column is the same sequence of images for the "noised-up" initial data

Compare[] takes 8 arguments:
                The first four are    1) The input discrete lattice reference data
                            2) The fourier transform of the input reference data
                            3)  The input "perturbed" data
                            4)  The fourier transform of the perturbed data
                            
                The second four are
                            1-2) the x and y lattice coordinates of the center of the square "aperature" in fourier space (0,0) is the center and the
                                edge depends on the size of the data.
                            3-4)  twice the width and height of the aperature.

In[257]:=

An example, use MakeLattice to produce a "clean" and a "noised-up" lattice

In[258]:=

latdata = MakeLattice[400, 400, {0, 20, 40}, {16, 4, 25}, 4, {0, 0}] ;

fourlat = Fourier[latdata] ;

In[260]:=

thermallatdata = MakeLattice[400, 400, {0, 20, 40}, {16, 4, 25}, 4, {-1, 1}] ; thermalfourlat = Fourier[thermallatdata] ;

In[261]:=

Compare[latdata, fourlat, thermallatdata, thermalfourlat, 0, 0, 50, 50]

[Graphics:HTMLFiles/Lecture-18_79.gif]

data is 400 wide, and 400 high<br />

In[262]:=

Compare[latdata, fourlat, thermallatdata, thermalfourlat, 100, 100, 25, 25]

[Graphics:HTMLFiles/Lecture-18_82.gif]

In[263]:=

Compare[latdata, fourlat, thermallatdata, thermalfourlat, 20, 30, 15, 15]

[Graphics:HTMLFiles/Lecture-18_84.gif]

In[264]:=

Compare[latdata, fourlat, thermallatdata, thermalfourlat, 30, 30, 15, 15]

[Graphics:HTMLFiles/Lecture-18_86.gif]

In[265]:=

Compare[latdata, fourlat, thermallatdata, thermalfourlat, 35, 25, 15, 15]

[Graphics:HTMLFiles/Lecture-18_88.gif]

This suggests the (potentially) interesting exercise of modifying compare to take two aperature specifications to "pick out" other periodicities in the lattice--i.e., something like the following:
      
      Compare[cleandata_ , fouriercleandata_ , noisydata_, fouriernoisydata_,  {FirstApLowX_, FirstApHiX_ , FirstApLowY_, FirstApHiY_}, {SecondApLowX_,SecondApHiX_ , SecondApLowY_, SecondApHiY_}] :=

Consider what happens to the image when the noise is anisotropic... Modify the function MakeLattice to take two "noise arguments"

In[266]:=

The following data only has fluctuations in the up and down direction:

In[267]:=

thermallatdata = MakeLattice[400, 400, {0, 20, 40}, {16, 4, 25}, 4, {0, 0}, {-4, 4}] ; thermalfourlat = Fourier[thermallatdata] ;

The resulting Fourier transform gets "streaked" in the left and right direction

In[340]:=

Compare[latdata, fourlat, thermallatdata, thermalfourlat, 0, 0, 200, 200]

[Graphics:HTMLFiles/Lecture-18_92.gif]

With the following aperature, we tend to pick out one lattice vector, but not the other

In[351]:=

Compare[latdata, fourlat, thermallatdata, thermalfourlat, 60, 10, 25, 15]

[Graphics:HTMLFiles/Lecture-18_94.gif]

Fourier Transforms on Images

Importing an image into Mathematica, .gif is some of many graphics data types that Mathematica can process.

In[294]:=

AnImage = Import["/Users/ccarter/classes/3016/Images/fourier_xtal_data.gif"] ;

In[295]:=

Show[AnImage, DisplayNow]

[Graphics:HTMLFiles/Lecture-18_97.gif]

Out[295]=

-Graphics -

The gray values of this image are stored in the (1,1) position of the image with gray values in the range (0,255)

In[298]:=

ImageData = AnImage[[1, 1]]/255 ;

In[299]:=

Dimensions[ImageData]

Out[299]=

{249, 250}

In[300]:=

FourierImageData = Fourier[ImageData] ;

In[301]:=

Show[GraphicsArray[{ImagePlot[ImageData], FourierImagePlot[FourierImageData], ImagePlot[Chop[InverseFourier[FourierImageData]]]}], ImageSize→1000, DisplayNow]

[Graphics:HTMLFiles/Lecture-18_104.gif]

Out[301]=

-GraphicsArray -

Write a function that takes a file as input, as well as an aperature specification, then displays the image, its transform and its reverse transform of the aperature fraction of the image

In[275]:=

In[303]:=

ImageFourierAperature["/Users/ccarter/classes/3016/Images/pentagon1.gif", -1, 1, -1, 1]

[Graphics:HTMLFiles/Lecture-18_108.gif]

In[304]:=

ImageFourierAperature["/Users/ccarter/classes/3016/Images/pentagon2.gif", -1, 1, -1, 1]

[Graphics:HTMLFiles/Lecture-18_110.gif]

In[307]:=

ImageFourierAperature["/Users/ccarter/classes/3016/Images/pentagon3.gif", -1, 1, -1, 1]

[Graphics:HTMLFiles/Lecture-18_112.gif]

In[308]:=

ImageFourierAperature["/Users/ccarter/classes/3016/Images/pentagon1.gif", .04, .14, .05, .15]

[Graphics:HTMLFiles/Lecture-18_114.gif]

In[309]:=

ImageFourierAperature["/Users/ccarter/classes/3016/Images/pentagon1.gif", -.3, .325, -.1, .125]

[Graphics:HTMLFiles/Lecture-18_116.gif]

In[311]:=

ImageFourierAperature["/Users/ccarter/classes/3016/Images/polycrystal.gif", .1, .3, .2, .4]

[Graphics:HTMLFiles/Lecture-18_118.gif]

In[312]:=

ImageFourierAperature["/Users/ccarter/classes/3016/Images/PrincessStickyBug.gif", -1, 1, -1, 1]

[Graphics:HTMLFiles/Lecture-18_120.gif]

The gray values of this image are stored in the (1,1) position of the image with gray values in the range (0,255)

In[319]:=

ImageFourierAperature["/Users/ccarter/classes/3016/Images/BradyPSB.gif", -1, 1, -1, 1]

[Graphics:HTMLFiles/Lecture-18_122.gif]

In[330]:=

ImageFourierAperature["/Users/ccarter/classes/3016/Images/BradyPSB.gif", -0.025, .025, -.025, .025]

[Graphics:HTMLFiles/Lecture-18_124.gif]

In[333]:=

ImageFourierAperature["/Users/ccarter/classes/3016/Images/BradyPSB.gif", 0.025, .275, 0.025, .275]

[Graphics:HTMLFiles/Lecture-18_126.gif]

In[326]:=

ImageFourierAperature["/Users/ccarter/classes/3016/Images/BradyPSB.gif", .25, 1, .25, 1]

[Graphics:HTMLFiles/Lecture-18_128.gif]

In[329]:=

ImageFourierAperature["/Users/ccarter/classes/3016/Images/BradyPSB.gif", .25, 1, -1, -0.25]

[Graphics:HTMLFiles/Lecture-18_130.gif]

In[334]:=

ImageFourierAperature["/Users/ccarter/classes/3016/Images/PrincessStickyBug.gif", .025, 1, .025, 1]

[Graphics:HTMLFiles/Lecture-18_132.gif]

In[338]:=

ImageFourierAperature["/Users/ccarter/classes/3016/Images/PrincessStickyBug.gif", -1, 1, -0.025, 0.025]

[Graphics:HTMLFiles/Lecture-18_134.gif]

In[339]:=

ImageFourierAperature["/Users/ccarter/classes/3016/Images/PrincessStickyBug.gif", -0.025, 0.025, -1, 1]

[Graphics:HTMLFiles/Lecture-18_136.gif]


Created by Mathematica  (November 3, 2005) Valid XHTML 1.1!