Mapping a Square by Complex Functions

cosine[x_,y_]:={Re[Cos[x+I*y]], Im[Cos[x+I*y]]};
double[x_,y_]:={2x,2y};
exp[x_,y_]:={Exp[x]*Cos[y],Exp[x]*Sin[y]};
itimes[x_,y_]:={-y,x};
negative[x_,y_]:={-x,-y};
sine[x_,y_]:={Re[Sin[x+I*y]], Im[Sin[x+I*y]]};
square[x_,y_]:={x^2-y^2, 2x*y};
zbar[x_,y_]:={x,-y};

cf[u_,v_,pt_]:= RGBColor[(u+1-First[pt])/2,(v+1-Last[pt])/2,0];

functionlist={1->"(x,y)=(cos(u)cosh(v),sin(u)sinh(v)",
2->"(x,y)=(2u,2v)",
3->"(x,y)=Exp(x)*(cos(y),sin(y) )",
4->"(x,y)=(-v,u)",
5->"(x,y)=(-u,-v)",
6->"(x,y)=(sin(u)cosh(v),cos(u)sinh(v)",
7->"(x,y)=(u^2-v^2,2uv)",
8->"(x,y)=(u,-v)"};

mapping[k_]:=Switch[k, 
1,Function[{x,y},cosine[x,y]],
2,Function[{x,y}, double[x,y]],
3,Function[{x,y},exp[x,y]],
4,Function[{x,y}, itimes[x,y]],
5,Function[{x,y}, negative[x,y]],
6,Function[{x,y}, sine[x,y]],
7,Function[{x,y}, square[x,y]],
8,Function[{x,y}, zbar[x,y]]];

plotranges[function_]:=Switch[function,
1,Automatic,
2, 4*{{-1,1},{-1,1}},
3, Automatic,
4, 2*{{-1,1},{-1,1}},
5, {{-1,1},{-1,1}},
6, Automatic,
7, Automatic,
8, 2*{{-1,1},{-1,1}}]

squaretest[u_,v_,pt_]:=First[pt]-1≤u&&u≤First[pt]+1&&Last[pt]-1≤v&&v≤Last[pt]+1;

Manipulate[Grid[{{
ParametricPlot[{u,v}, {u,First[a]-1,First[a]+1},{v,Last[a]-1,Last[a]+1},
 Frame->False,
ColorFunction->Function[{x,y,u,v}, cf[u,v,a]],
ColorFunctionScaling->False,
ImageSize->{290, 290},
Mesh->False,
PlotLabel->Row[{Style["u,v",Italic]," plane"}],
PlotRange->2*unitblock
],
ParametricPlot[mapping[function][u,v], {u,First[a]-1,First[a]+1},{v,Last[a]-1,Last[a]+1}, 
Frame->False, 
ColorFunction->Function[{x,y,u,v},
Which[MemberQ[{2,3,4,5,8},function],cf[u,v,a], 
function==1,If[squaretest[-u,v,a],Blend[{cf[u,v,a],cf[-u,v,a]}],cf[u,v,a]],
function==6,If[squaretest[u-Pi/2,-v,a],Blend[{cf[u,v,a],cf[u-Pi/2,v,a]}],cf[u,v,a]],
function==7, If[squaretest[-u,-v,a],Blend[{cf[u,v,a],cf[-u,-v,a]}],cf[u,v,a]]]],
ColorFunctionScaling->False,
ImageSize->{290,290},
Mesh->False,
PlotLabel->Row[{Style["x,y",Italic]," plane"}],
PlotPoints->Which[MemberQ[{2,3,4,5,8},function],10,
function==7,50,
function==1||function==6, 75],
PlotRange->plotranges[function],
ImagePadding->25]}}],
{{a,{1,1}},{-1,-1},{1,1}, Locator, Appearance->Style["●",Medium,Black]},
{{function,2, "mapping"},Evaluate@functionlist},
SaveDefinitions->True]

THIS NOTEBOOK IS THE SOURCE CODE FROM

"Mapping a Square by Complex Functions" from The Wolfram Demonstrations Project
 http://demonstrations.wolfram.com/MappingASquareByComplexFunctions/

Contributed by: Chris Boucher

A full-function Wolfram Mathematica 6 system is required to edit this notebook.
GET WOLFRAM MATHEMATICA 6 »

© The Wolfram Demonstrations Project & Contributors   |   Terms of Use   |   Make a new version of this Demonstration »