2D Fourier Transforms

Manipulate[
(*Main processing code*)
Module[{inputprimitives,inputgraphic,inputplaneimage,inputplane,ftim,ftimg,inputplanegreen,a,b,c,d,e,ir,ft,ftab2},
gsc[image_]:=gsc[image,color];
inputprimitives=Rotate[
If[latticetype==1,
convoluteshapewithcomb[type,nx,ny,10^logradius,{10^loggridspacingx,10^loggridspacingy},internalshaperotation,externalshaperotation,annulusthickness],
convoluteshapewithpolygongrid[type,latticetype,10^logradius,{10^loggridspacingx,10^loggridspacingy},internalshaperotation,externalshaperotation,annulusthickness,pluszerozero]]
,rotation];
If[invertinput,inputplaneimage=ColorNegate[Image[ColorConvert[Graphics[{White,inputprimitives},PlotRange->plotrange,ImageSize->{resolution,resolution},Frame->False,Background->Black],"Grayscale"]]],inputplaneimage=Image[ColorConvert[Graphics[{White,inputprimitives},PlotRange->plotrange,ImageSize->{resolution,resolution},Frame->False,Background->Black],"Grayscale"]]];
inputplane=ImageData[inputplaneimage];
ft=Abs[spl[Fourier[inputplane]]];
ftab2=Abs[ft]^2;
If[logintensity,
e=Log[1*(10^(-5))+ftab2];d=(4*logbrightnessscaling+e);c=e+10;ir=All,
c=d=(10^logbrightnessscaling*ftab2);ir={0,1}
];
ftim=Image[d];
Switch[axisframe,
3,

a=Graphics[{
Inset[gsc[inputplaneimage],{0,0},Center,range],
Inset[ListLinePlot[inputplane[[resolution[[1]]/2+1]],DataRange->plotrange[[1]],Axes->False,PlotStyle->Directive[Blue,Thick],AspectRatio->0.2,PlotRange->Automatic],Scaled[{0.5,0.05}],{0,0},2],
Inset[ListLinePlot[inputplane[[All,resolution[[1]]/2+1]],DataRange->plotrange[[2]],Axes->False,PlotStyle->Directive[Blue,Thick],AspectRatio->0.2,PlotRange->Automatic],Scaled[{0.95,0.5}],{0,0},2,{0,1}]},
PlotRange->plotrange,Frame->True,ImagePadding->pad,FrameLabel->{Style["x/λ",Black,Italic],Style["y/λ",Black,Italic]},LabelStyle->Directive[Black,12],FrameTicks->Automatic,FrameTicksStyle->Directive[Black],FrameStyle->Directive[White],RotateLabel->False];
b=Graphics[{
Inset[gsc[ftim],{0,0},Center,krange],
Inset[ListLinePlot[c[[resolution[[1]]/2+1]],DataRange->kplotrange[[1]],Axes->False,PlotStyle->Directive[Blue,Thick],AspectRatio->0.2,PlotRange->{Full,ir}],Scaled[{0.5,0.05}],{0,0},krange],
Inset[ListLinePlot[c[[All,resolution[[1]]/2+1]],DataRange->kplotrange[[2]],Axes->False,PlotStyle->Directive[Blue,Thick],AspectRatio->0.2,PlotRange->{Full,ir}],Scaled[{0.95,0.5}],{0,0},krange,{0,1}]},
PlotRange->kplotrange,Frame->True,ImagePadding->pad,FrameLabel->{Style["(Subscript[k, x])",Black],Style["(Subscript[k, y])",Black]},LabelStyle->Directive[Black,12],FrameTicks->Automatic,FrameTicksStyle->Directive[Black],FrameStyle->Directive[White],RotateLabel->False];
GraphicsGrid[{{a},{b}},(*ImageSize->{1,2}*(resolution+Map[Total,pad])*)ImageSize->{1,2}*resolution,Spacings->{0,0}],
2,
GraphicsGrid[{{inputplaneimage},{ftim}},ImageSize->{1,2}*resolution,Spacings->{0,0}],
4,
GraphicsGrid[{{gsc[inputplaneimage]},{gsc[ftim]}},ImageSize->{1,2}*resolution,Spacings->{0,0}]
]],
(*Options and variables*)
Style["aperture shape controls",Bold],
{{type,16,"type"},{16->"disk",15->"annulus",14->"slit",13->"Gaussian",3->"triangle",4->"square",5->"pentagon",6->"hexagon",7->"heptagon",8->"octagon",9->"nonagon",10->"decagon",11->"undecagon",12->"dodecagon",17->"T",19->"7",20->"cross 1",21->"cross 2",23->"A",22->"S"}},
{{logradius,{-1,-1},Tooltip["scaling","logarithmic scale"]},{-2,-2},{Log10[Sqrt[2]],Log10[Sqrt[2]]},ImageSize->Small},
{{annulusthickness,.1,"line width"},0,1,ImageSize->Tiny},
{{internalshaperotation,-Pi*0.25,"internal shape rotation"},-Pi,Pi,ImageSize->Tiny},
{{externalshaperotation,0,"external shape rotation"},-Pi,Pi,ImageSize->Tiny},
Delimiter,
Style["lattice controls",Bold],
{{latticetype,1,"lattice type"},{1->"comb",3->"triangle",4->"square",5->"pentagon",6->"hexagon",7->"heptagon",8->"octagon",9->"nonagon",10->"decagon",11->"undecagon",12->"dodecagon"}},
Style["comb number",Bold],
{{pluszerozero,False,"zero\[Hyphen]point"},{True,False}},
{{nx,1,"x axis"},0,10,1,ImageSize->Tiny},
{{ny,1,"y axis"},0,10,1,ImageSize->Tiny},
Style["(Subscript[Log, 10])(comb spacing)",Bold],
{{loggridspacingx,-0.5,"x axis (Subscript[d, x])"},-2,0.5,ImageSize->Tiny},
{{loggridspacingy,-0.5,"y axis (Subscript[d, Y])"},-2,0.5,ImageSize->Tiny},
Delimiter,
Style["whole image controls",Bold],
{{rotation,0,"rotation"},0,2Pi,ImageSize->Tiny},
{{invertinput,False,"invert input aperture"},{True,False}},
{{logintensity,False,"log of intensity"},{True,False}},
{{logbrightnessscaling,1,Tooltip["scaling","logarithmic scale"]},-4,3,ImageSize->Tiny},
{color,Green},
{{axisframe,3,"display type"},{2->"fast",4->"color",3->"axes"},ControlType->PopupMenu},
ContinuousAction->If[type,Gaussian,False,True],
TrackedSymbols->True,ControlPlacement->Left,
Initialization:>(
Get["Polytopes`"];
(*Initialization variables define the global behaviour of the plots. This is useful in defining the plotrange for the slits which should always occupy the whole length or width of the graph..*)resolution={246,246};
nullim=Image[ConstantArray[0,resolution]];
pad={{50,20},{35,10}};
plotrange={{-1,1},{-1,1}};
range={Max[plotrange[[1]]]-Min[plotrange[[1]]],Max[plotrange[[1]]]-Min[plotrange[[2]]]};
dxdy=range/resolution;
kplotrange={{-Pi/dxdy[[1]],Pi/dxdy[[1]]},{-Pi/dxdy[[2]],Pi/dxdy[[2]]}};
krange={Max[kplotrange[[1]]]-Min[kplotrange[[1]]],Max[kplotrange[[1]]]-Min[kplotrange[[2]]]};
pointdensity=Max[resolution]/Max[range];
spl[array_]:=Module[{part},part=Partition[array,Dimensions[array]/2];Join[Join[part[[2,2]],part[[2,1]],2],Join[part[[1,2]],part[[1,1]],2],1]
];
(*Produces a gaussian as an image primitive.*)
gaussraster[res_]:=Raster[
Table[{1,(E^-((x^2/(2(res[[1]]/6)^2)+y^2/(2(res[[2]]/6)^2))))},{x,-res[[1]]/2,res[[1]]/2,1},{y,-res[[2]]/2,res[[2]]/2,1}],
{{-6,-6},{6,6}}];
(*Unified shape making function, takes into account the nuances of each of the cases to produce a shape with a standard size - 1 unit along each side. Transformations can be carried out later.*)
shape[type_,position_,radius_,internalshaperotation_,externalshaperotation_,annulusthickness_]:=
Module[{trafo,baser},
trafo=Composition[RotationTransform[externalshaperotation,position],TranslationTransform[position],ScalingTransform[radius],RotationTransform[internalshaperotation]];
Switch[type,
3,Polygon[trafo[Vertices[Polytopes`Triangle]]],
4,Polygon[trafo[Vertices[Polytopes`Square]]],
5,Polygon[trafo[Vertices[Polytopes`Pentagon]]],
6,Polygon[trafo[Vertices[Polytopes`Hexagon]]],
7,Polygon[trafo[Vertices[Polytopes`Heptagon]]],
8,Polygon[trafo[Vertices[Polytopes`Octagon]]],
9,Polygon[trafo[Vertices[Polytopes`Nonagon]]],
10,Polygon[trafo[Vertices[Polytopes`Decagon]]],
11,Polygon[trafo[Vertices[Polytopes`Undecagon]]],
12,Polygon[trafo[Vertices[Polytopes`Dodecagon]]],
16,GeometricTransformation[Disk[],trafo],
15,GeometricTransformation[{Thickness[annulusthickness],Circle[]},trafo],
14,Rotate[Rectangle[{position[[1]]-radius[[1]],1.5*Min[plotrange]},{position[[1]]+radius[[1]],1.5*Max[plotrange]}],externalshaperotation],
13,GeometricTransformation[gaussraster[6*pointdensity*radius],trafo],


19,GeometricTransformation[{Thickness[annulusthickness],CapForm["Butt"],Line[N@{{-((Sqrt[3])/2),(1/2)},{((Sqrt[3])/2),(1/2)},{0,-1}}]},trafo],
20,GeometricTransformation[{Thickness[annulusthickness],CapForm["Butt"],Line[N@{{{-((Sqrt[3])/2),0},{((Sqrt[3])/2),0}},{{((Sqrt[3])/2),(1/2)},{0,-1}}}]},trafo],
21,GeometricTransformation[{Thickness[annulusthickness],CapForm["Butt"],Line[N@{{{-((Sqrt[3])/2),0},{((Sqrt[3])/2),0}},{{((Sqrt[3])/4),(1/2)},{-((Sqrt[3])/4),-1}}}]},trafo],
17,GeometricTransformation[{Thickness[annulusthickness],CapForm["Butt"],Line[{{-0.5,0.5},{0.5,0.5},{0,0.5},{0,-0.5}}]},trafo],
22,GeometricTransformation[{Thickness[annulusthickness],CapForm["Butt"],Circle[{0,0.5},0.5,{0,1.5Pi}],Circle[{0,-0.5},0.5,{Pi,2.5Pi}]},trafo],
23,GeometricTransformation[{Thickness[annulusthickness],CapForm["Butt"],Line[N@{{((Sqrt[3])/2),-(3/4)},{0,3/4},{-((Sqrt[3])/2),-(3/4)}}],Line[N@{{((Sqrt[3])/4),(0/4)},{-((Sqrt[3])/4),(0/4)}}]},trafo]]
];

(*Comb convolution function; puts a copy of shape at each position on a grid which is rectangular. It is possible to implement a variable basis (where a different arrangement of points is placed at each lattice point) to make any arbitrary repeating lattice shape, but this obfuscates the purpose of this demonstration.*)
convoluteshapewithcomb[type_,nx_,ny_,radius_,gridspacing_,internalshaperotation_,externalshaperotation_,annulusthickness_]:=
Table[
shape[type,{x,y},radius,internalshaperotation,externalshaperotation,annulusthickness],
{x,-(nx-1)*0.5*gridspacing[[1]],+(nx-1)*0.5*gridspacing[[1]],gridspacing[[1]]},{y,-(ny-1)*0.5*gridspacing[[2]],+(ny-1)*0.5*gridspacing[[2]],gridspacing[[2]]}
];

(*Polygon grid convolution function; puts a copy of a shape at each vertex on a scaled polygon grid.*)
convoluteshapewithpolygongrid[type_,latticen_,radius_,gridspacing_,internalshaperotation_,externalshaperotation_,annulusthickness_,pluszerozero_]:=
Module[{points,latticetype},
latticetype=Switch[latticen,
3,Polytopes`Triangle,
4,Polytopes`Square,
5,Polytopes`Pentagon,
6,Polytopes`Hexagon,
7,Polytopes`Heptagon,
8,Polytopes`Octagon,
9,Polytopes`Nonagon,
10,Polytopes`Decagon,
11,Polytopes`Undecagon,
12,Polytopes`Dodecagon
];
points=If[pluszerozero,
ConstantArray[gridspacing,NumberOfVertices[latticetype]+1]*Append[Vertices[latticetype],{0,0}],
ConstantArray[gridspacing,NumberOfVertices[latticetype]]*Vertices[latticetype]
];
Table[
shape[type,p,radius,internalshaperotation,externalshaperotation,annulusthickness],
{p,points}
]];
gsc[image_,RGBColor[r_,g_,b_]]:=Module[{d},d=ImageData[image] ;ColorCombine[{Image[r*d],Image[g*d],Image[b*d]}]];
gsc[image_,GrayLevel[v_]]:=Module[{d},d=ImageData[image];ColorCombine[{Image[v*d],Image[v*d],Image[v*d]}]];

)
]

This Demonstration shows an aperture (top) and its 2D Fourier transform (bottom). These can be pictured as an aperture illuminated by plane waves and the diffraction pattern in an optical system with a small Fresnel number. Note how lines of symmetry are shared in the aperture and its Fourier transform and how these are preserved under rotations. Particularly important is the way that the Fourier transform scales with the aperture—if the aperture widens, then the Fourier transform narrows in the same direction, and vice versa. It is instructive to note how the same processes apply analogously when looking at lattices of apertures.

Contributed by: John Holland