Fourier Theory and Fourier Transforms

Discrete Fourier Transforms on very simple lattices

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

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

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

Join[WhiteSquare, BlackSquare, BlackSquare]//MatrixForm

( 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 )

Example of construction of a  slightly larger structure

latcell = Join [ Transpose [ Join [ BlackSquare , BlackSquare , BlackSquare , BlackSquare ] ] , Transpose [ Join [ BlackSquare , BlackSquare , WhiteSquare , BlackSquare ] ] , Transpose [ Join [ BlackSquare , BlackSquare , WhiteSquare , BlackSquare ] ] , Transpose [ Join [ BlackSquare , BlackSquare , BlackSquare , BlackSquare ] ] ] ;

Visualize structure:

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

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

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

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

example:

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

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

DensityGraphics

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

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

example:

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

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

DensityGraphics

Create a 256 by 256 data set

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

Function to create graphics for delayed display

DisplayLater = DisplayFunction→Identity ;

DisplayNow = DisplayFunction→ $DisplayFunction ;

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

Example

XtalImage = ImagePlot [ XtalData ]

DensityGraphics

To see the data:

Show [ XtalImage , DisplayNow , ImageSize 400 ]

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

DensityGraphics

Take Discrete Fourier Transform of constructed simple lattice

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

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]

FourierImage = FourierImagePlot [ FourierData ]

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.

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

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

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:

<<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]

DensityGraphics

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

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).

HoleFunc [ data_ , xc_ , yc_ , twicew_ , twiceh_ ] := Module [ { nrows , ncols } , nrows = Dimensions [ data ] [ [ 1 ] ] ; ncols = Dimensions [ data ] [ [ 2 ] ] ; Table [ If [ And [ Abs [ j - xc ] <= twicew , Abs [ i - yc ] <= twiceh ] , 0 , 1 ] , { i , nrows } , { j , ncols } ] ] ;

General :: spell1 : Possible spelling error: new symbol name \" nrows \" is similar to existing symbol \" rows \". More… "Possible spelling error: new symbol name \\\"\\!\\(nrows\\)\\\" is similar to existing symbol \\\"\\!\\(rows\\)\\\". \\!\\(\\*ButtonBox[\\\"More\[Ellipsis]\\\", ButtonStyle->\\\"RefGuideLinkText\\\", ButtonFrame->None, ButtonData:>\\\"General::spell1\\\"]\\)"

General :: spell1 : Possible spelling error: new symbol name \" ncols \" is similar to existing symbol \" cols \". More… "Possible spelling error: new symbol name \\\"\\!\\(ncols\\)\\\" is similar to existing symbol \\\"\\!\\(cols\\)\\\". \\!\\(\\*ButtonBox[\\\"More\[Ellipsis]\\\", ButtonStyle->\\\"RefGuideLinkText\\\", ButtonFrame->None, ButtonData:>\\\"General::spell1\\\"]\\)"

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

Create template for defect creation

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

Recreate Images and Redisplay

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

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

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

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

MakeLattice [ W_ , H_ , latvecA_ , latvecB_ , size_ , randrange_ ] := Module [ { result = Table [ 0 , { i , H } , { j , W } ] , lata = - 1 , latb = - 1 , xpos , ypos , untouched = Table [ True , { i , H } , { j , W } ] } , For [ lata = 0 , lata latvecA [ [ 3 ] ] , For [ latb = 0 , latb latvecB [ [ 3 ] ] , xpos = Mod [ lata * latvecA [ [ 1 ] ] + latb * latvecB [ [ 1 ] ] , H , 1 ] ; ypos = Mod [ lata * latvecA [ [ 2 ] ] + latb * latvecB [ [ 2 ] ] , W , 1 ] ; If [ untouched [ [ ypos , xpos ] ] , untouched [ [ ypos , xpos ] ] = False ; xpos += Random [ Integer , randrange ] ; ypos += Random [ Integer , randrange ] ; For [ j = 1 , j size , For [ i = 1 , i size , result [ [ Mod [ ypos + j , H , 1 ] , Mod [ xpos + i , W , 1 ] ] ] = 1 ; i ++ ] ; j ++ ] ] ; latb ++ ] ; lata ++ ] ; result ]

General :: spell1 : Possible spelling error: new symbol name \" ypos \" is similar to existing symbol \" xpos \". More… "Possible spelling error: new symbol name \\\"\\!\\(ypos\\)\\\" is similar to existing symbol \\\"\\!\\(xpos\\)\\\". \\!\\(\\*ButtonBox[\\\"More\[Ellipsis]\\\", ButtonStyle->\\\"RefGuideLinkText\\\", ButtonFrame->None, ButtonData:>\\\"General::spell1\\\"]\\)"

General :: spell1 : Possible spelling error: new symbol name \" lata \" is similar to existing symbol \" data \". More… "Possible spelling error: new symbol name \\\"\\!\\(lata\\)\\\" is similar to existing symbol \\\"\\!\\(data\\)\\\". \\!\\(\\*ButtonBox[\\\"More\[Ellipsis]\\\", ButtonStyle->\\\"RefGuideLinkText\\\", ButtonFrame->None, ButtonData:>\\\"General::spell1\\\"]\\)"

General :: spell1 : Possible spelling error: new symbol name \" latb \" is similar to existing symbol \" lata \". More… "Possible spelling error: new symbol name \\\"\\!\\(latb\\)\\\" is similar to existing symbol \\\"\\!\\(lata\\)\\\". \\!\\(\\*ButtonBox[\\\"More\[Ellipsis]\\\", ButtonStyle->\\\"RefGuideLinkText\\\", ButtonFrame->None, ButtonData:>\\\"General::spell1\\\"]\\)"

General :: stop : Further output of General :: spell1 will be suppressed during this calculation. More… "Further output of \\!\\(General :: \\\"spell1\\\"\\) will be suppressed during this calculation. \\!\\(\\*ButtonBox[\\\"More\[Ellipsis]\\\", ButtonStyle->\\\"RefGuideLinkText\\\", ButtonFrame->None, ButtonData:>\\\"General::stop\\\"]\\)"

Example of a lattice with no noise:

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

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

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

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...

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..

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

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

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.

Compare [ sharpdata_ , sharpfourierdata_ , diffusedata_ , diffusefourierdata_ , ApCenterx_ , ApCentery_ , ApTwicewidth_ , ApTwiceheight_ ] := Module [ { sharpfourieraperature , diffusefourieraperature , dims = Dimensions [ sharpdata ] , nrows , ncols , sharpfourimage , sharpapimage , diffusefourierimage , diffuseapimage , sharprevfourimage , diffusefourimage , sharpfourmagimage , diffusefourmagimage , aperature , xll , yll , xur , yur , theShiftedAperature , shiftedsharpfourier , shifteddiffusefourier , xc , yc } , nrows = dims [ [ 1 ] ] ; ncols = dims [ [ 2 ] ] ; shiftedsharpfourier = KZeroAtCenter [ sharpfourierdata ] ; shifteddiffusefourier = KZeroAtCenter [ diffusefourierdata ] ; sharpfourimage = ListDensityPlot [ Abs [ shiftedsharpfourier ] , Mesh -> False , FourierColorFunctionBlackBack , (* ColorFunctionScaling False , *) DisplayLater ] ; diffusefourimage = ListDensityPlot [ Abs [ shifteddiffusefourier ] , Mesh -> False , FourierColorFunctionBlackBack , (* ColorFunctionScaling False , *) DisplayLater ] ; xc = Round [ ncols / 2 ] + ApCenterx ; yc = Round [ nrows / 2 ] + ApCentery ; xll = xc - ApTwicewidth ; yll = yc - ApTwiceheight ; xur = xc + ApTwicewidth ; yur = yc + ApTwicewidth ; If [ And [ xll < 1 , yll < 1 , xur > ncols , yur > nrows ] , sharpfourieraperature = shiftedsharpfourier ; diffusefourieraperature = shifteddiffusefourier , aperature = Table [ If [ And [ Abs [ i - yc ] <= ApTwiceheight , Abs [ j - xc ] <= ApTwicewidth ] , 1 , 0 ] , { i , nrows } , { j , ncols } ] ; sharpfourieraperature = aperature * shiftedsharpfourier ; diffusefourieraperature = aperature * shifteddiffusefourier ] ; theShiftedAperature = Line [ { { xll - 1 , yll - 1 } , { xur + 1 , yll - 1 } , { xur + 1 , yur + 1 } , { xll - 1 , yur + 1 } , { xll - 1 , yll - 1 } } ] ; sharpapimage = Show [ sharpfourimage , Graphics [ { (* Hue [ .5 , .5 , 1 ] *) Hue [ .1667 , 1 , 1 ] , Thickness [ 2 / nrows ] , theShiftedAperature } ] ] ; diffuseapimage = Show [ diffusefourimage , Graphics [ { (* Hue [ .5 , .5 , 1 ] *) Hue [ .1667 , 1 , 1 ] , Thickness [ 2 / nrows ] , theShiftedAperature } ] ] ; (* Print [ data is , nrows , wide, and , ncols , high\n , Aperature is x∈( , xll , , , xur , ) y∈( , yll , , , yur , ) ] ; *) xll = If [ xll < 1 , 1 , xll ] ; xur = If [ xur > nrows , nrows , xur ] ; yll = If [ yll < 1 , 1 , yll ] ; yur = If [ yur > ncols , ncols , yur ] ; sharpfourmagimage = ListDensityPlot [ Abs [ shiftedsharpfourier ] [ [ Range [ yll , yur ] , Range [ xll , xur ] ] ] , Mesh -> False , FourierColorFunctionBlackBack , (* ColorFunctionScaling False , *) DisplayLater ] ; diffusefourmagimage = ListDensityPlot [ Abs [ shifteddiffusefourier ] [ [ Range [ yll , yur ] , Range [ xll , xur ] ] ] , Mesh -> False , FourierColorFunctionBlackBack , (* ColorFunctionScaling False , *) DisplayLater ] ; sharprevfourimage = ListDensityPlot [ Abs [ Chop [ InverseFourier [ KZeroAtCenter [ sharpfourieraperature ] ] ] ] , Mesh False , DisplayLater ] ; diffuserevfourimage = ListDensityPlot [ Abs [ Chop [ InverseFourier [ KZeroAtCenter [ diffusefourieraperature ] ] ] ] , Mesh False , DisplayLater ] ; Show [ GraphicsArray [ { { ImagePlot [ sharpdata ] , ImagePlot [ diffusedata ] } , { sharpapimage , diffuseapimage } , { sharprevfourimage , diffuserevfourimage } , { sharpfourmagimage , diffusefourmagimage } } ] , ImageSize 1000 , GraphicsSpacing { .001 , .0 } , DisplayNow ] ; ]

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

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

fourlat = Fourier[latdata] ;

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

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

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

data is 400 wide, and 400 high SequenceForm data is 400 wide, and 400 high

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

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

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

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

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

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

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

[Graphics:HTMLFiles/Lecture-18_34.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"

MakeLattice [ W_ , H_ , latvecA_ , latvecB_ , size_ , Xrandrange_ , Yrandrange_ ] := Module [ { result = Table [ 0 , { i , H } , { j , W } ] , lata = - 1 , latb = - 1 , xpos , ypos , untouched = Table [ True , { i , H } , { j , W } ] } , For [ lata = 0 , lata latvecA [ [ 3 ] ] , For [ latb = 0 , latb latvecB [ [ 3 ] ] , xpos = Mod [ lata * latvecA [ [ 1 ] ] + latb * latvecB [ [ 1 ] ] , H , 1 ] ; ypos = Mod [ lata * latvecA [ [ 2 ] ] + latb * latvecB [ [ 2 ] ] , W , 1 ] ; If [ untouched [ [ ypos , xpos ] ] , untouched [ [ ypos , xpos ] ] = False ; xpos += Random [ Integer , Xrandrange ] ; ypos += Random [ Integer , Yrandrange ] ; For [ j = 1 , j size , For [ i = 1 , i size , result [ [ Mod [ ypos + j , H , 1 ] , Mod [ xpos + i , W , 1 ] ] ] = 1 ; i ++ ] ; j ++ ] ] ; latb ++ ] ; lata ++ ] ; result ]

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

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

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

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

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

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

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

Fourier Transforms on Images

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

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

Show [ AnImage , DisplayNow ]

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

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)

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

Dimensions [ ImageData ]

{ 249 , 250 }

FourierImageData = Fourier [ ImageData ] ;

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

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

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

ImageFourierAperature [ imagefile_ , Apxmin_ , Apxmax_ , Apymin_ , Apymax_ ] := Module [ { theimage = Import [ imagefile ] , dims , nrows , ncols , fourierdata , fourimage , fourieraperature , apimage , fourmagimage , revfourierimage , aperature , xll , yll , xur , yur } , fourierdata = KZeroAtCenter [ Fourier [ ( theimage [ [ 1 , 1 ] ] / 255 ) ] ] ; fourimage = ListDensityPlot [ Abs [ fourierdata ] , Mesh -> False , ImageSize 144 , FourierColorFunctionBlackBack , DisplayLater ] ; dims = Dimensions [ fourierdata ] ; nrows = dims [ [ 1 ] ] ; ncols = dims [ [ 2 ] ] ; xll = Round [ ncols / 2 + Apxmin * ncols / 2 ] ; yll = Round [ nrows / 2 + Apymin * nrows / 2 ] ; xur = Round [ ncols / 2 + Apxmax * ncols / 2 ] ; yur = Round [ nrows / 2 + Apymax * nrows / 2 ] ; xll = If [ xll < 1 , 1 , xll ] ; xur = If [ xur > ncols , ncols , xur ] ; yll = If [ yll < 1 , 1 , yll ] ; yur = If [ yur > nrows , nrows , yur ] ; aperature = Table [ If [ And [ i yll , i yur , j xll , j xur ] , 1 , 0 ] , { i , nrows } , { j , ncols } ] ; fourieraperature = aperature * fourierdata ; apimage = Show [ fourimage , Graphics [ { Hue [ .1667 , 1 , 1 ] , Thickness [ 2 / nrows ] , Line [ { { xll - 1 , yll - 1 } , { xur + 1 , yll - 1 } , { xur + 1 , yur + 1 } , { xll - 1 , yur + 1 } , { xll - 1 , yll - 1 } } ] } ] ] ; xll = If [ xll < 1 , 1 , xll ] ; xur = If [ xur > nrows , nrows , xur ] ; yll = If [ yll < 1 , 1 , yll ] ; yur = If [ yur > ncols , ncols , yur ] ; fourmagimage = ListDensityPlot [ Abs [ fourierdata [ [ Range [ yll , yur ] , Range [ xll , xur ] ] ] ] , Mesh -> False , FourierColorFunctionBlackBack , DisplayLater ] ; revfourimage = ListDensityPlot [ Abs [ Chop [ InverseFourier [ KZeroAtCenter [ fourieraperature ] ] ] ] , Mesh False , DisplayLater ] ; Show [ GraphicsArray [ { { theimage , apimage } , { revfourimage , fourmagimage } } ] , ImageSize 1000 , GraphicsSpacing { .001 , .0 } , DisplayNow ] ; ]

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

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

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

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

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

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

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

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

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

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

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

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

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

[Graphics:HTMLFiles/Lecture-18_45.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)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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