(* :Title: Arg Color Plot *) (* :Name: Graphics`ArgColorPlot` *) (* :Author: Bernd Thaller, Institute of Mathematics, University of Graz, A-8010 Graz bernd.thaller@kfunigraz.ac.at *) (* :Summary: Plot the absolute value Abs[f[x]] of a complex-valued function f depending on a real variable x and fill the space between the plotted function and the x-axis with a color corresponding to the argument Arg[f[x]]. *) (* :Package Version: 1.0 *) (* :Mathematica Version: 2.2.2 *) (* :Copyright: Copyright 1996, Bernd Thaller *) (* :Keywords: graphics, Plot, area under the curve, ArgColors *) (* :Limitations: The y-axis is drawn behind the graphics. Therefore the default options are set Axes->{True,None},Frame->True. y-axis is best included by defining a line and drawing it with Epilog option. Only one complex function can be plotted at a time, but a plot of a complex function can be combined with a plot of a real-valued function. For speed reasons, the complex function is compiled. The compiler may sometimes display error messages, but plotting still works. *) (* :Examples: Try the following: ArgColorPlot[Exp[-I 6 x - x^2/2],{x,-4,4}]; mytab = Table[Cos[x] + I Sin[x],{x,-4,4,.2}]; ListArgColorPlot[mytab]; CombinedPlot[{Gamma[I+x],Sin[Pi x]},{x,-4,3}]; mytab = Table[Sin[Pi x],{x,-4,3,.1}]; ListCombinedPlot[{mytab,Sin[Pi x]},{x,-4,3}]; *) BeginPackage["Graphics`ArgColorPlot`", "Utilities`FilterOptions`", "Graphics`Graphics`", "Global`"] ArgColorPlot::usage = "ArgColorPlot[f[x],{x,x0,x1},opts] is used like the usual Plot command. It gives a two-dimensional plot of a complex-valued function f of a single real variable x in the range {x0,x1}. The plot shows the curve Abs[f] with area between the curve and the x-axis colored by Hue[Arg[f[x]]/(2 Pi)]. The default options of Plot are changed to Axes->{True,None}, Fame->True." ListArgColorPlot::usage = "ListArgColorPlot[f,{x,x0,x1},opts] plots a Abs[f], where f is a list of complex numbers. The points of the list Abs[f] are joined by a line. The area between the curve and the x-axis is colored at each point by Hue[Arg[f]/(2 Pi)]." CombinedPlot::usage = "CombinedPlot[{f[x],g[x]},{x,x0,x1},opts] works like ArgColorPlot with respect to f. The curve g is drawn in front of the ArgColorPlot of f" ListCombinedPlot::usage = "ListCombinedPlot[{list,f[x]},{x,x0,x1},opts] works like ListArgColorPlot with respect to list. It is assumed that list represents the discretized values of a function defined on the interval [x0,x1]. The color list plot is then combined with an ordinary plot of f on the same scale and with the Ticks automatically adjusted." NiceTicks::usage = "NiceTicks[xmin,xmax,dx] provides a list of nice positions for use in the Ticks or FrameTicks option in a ListPlot, where it is assumed that the list of values ranges between xmin and xmax in steps dx." Begin["`Private`"] Attributes[ArgColorPlot] = {HoldAll}; ArgColorPlot[func_,{x_Symbol,xmin_,xmax_},opts___] := Module[{absfnc,argfnc,plot1,plot2,plot3, xvars1,xvars2,xvars3,xvars,values,hues,graph}, absfnc = Compile[{x},Abs[func]]; argfnc = Compile[{x},If[Abs[func]!=0,Arg[func]/2/Pi,0]]; plot1 = Plot[absfnc[x],{x,xmin,xmax}, opts, DisplayFunction->Identity]; plot2 = Plot[ Re[func],{x,xmin,xmax}, opts, DisplayFunction->Identity]; plot3 = Plot[ Im[func],{x,xmin,xmax}, opts, DisplayFunction->Identity]; xvars1 = First /@ Level[plot1[[1]],{4}]; xvars2 = First /@ Level[plot2[[1]],{4}]; xvars3 = First /@ Level[plot3[[1]],{4}]; xvars = Union[xvars1,xvars2,xvars3]; values = absfnc /@ xvars; hues = Hue[argfnc[#]]& /@ xvars; Show[fillit[xvars,hues,values], Evaluate[FilterOptions[Graphics,opts]], Axes->{True,None}, Frame->True ] ]/;NumberQ[N[xmin]] && NumberQ[N[xmax]] ListArgColorPlot[list_List,opts___] := Module[{i,xvars,hues,values}, xvars = Table[i,{i,Length[list]}]; hues = Hue[Arg[#]/(2*Pi)]& /@ list; values = Abs[list]; Show[fillit[xvars,hues,values], Evaluate[FilterOptions[Graphics,opts]], Axes->{True,None}, Frame->True ] ] Attributes[CombinedPlot] = {HoldAll}; CombinedPlot[{func1_,func2_}, {x_Symbol,xmin_,xmax_}, opts___Rule] := DisplayTogether[ArgColorPlot[func1, {x,xmin,xmax},opts], Plot[func2,{x,xmin,xmax},opts], Evaluate[FilterOptions[Graphics,opts]], Axes->{True,None}, Frame->True ] /; NumberQ[N[xmin]] && NumberQ[N[xmax]] ListCombinedPlot[{list_List,func_}, {x_Symbol,xmin_,xmax_}, opts___Rule] := Module[{len=Length[list],dx,x0,plotfunc}, dx = (xmax-xmin)/(len-1); x0 = ind[0,xmin,dx]; f = Function[{x},func]; plotfunc[y_] := f[dx*(y-x0)]; tic = genticks[xmin,xmax,dx,opts]; DisplayTogether[ ListArgColorPlot[list,opts], Plot[Evaluate[plotfunc[x]],{x,1,ind[xmax,xmin,dx]},opts], FrameTicks->tic, Evaluate[FilterOptions[Graphics,opts]], Frame->True, Axes->{True,None} ] ]/;NumberQ[N[xmin]] && NumberQ[N[xmax]] NiceTicks[xmin_,xmax_,dx_] := convertticks[LinearScale[xmin,xmax],xmin,dx] /; NumberQ[N[xmin]] && NumberQ[N[xmax]] && NumberQ[N[dx]] (* auxiliary functions *) genticks[xmin_,xmax_,dx_,opts___]:= Module[{tic}, tic = FrameTicks/.{opts}/.FrameTicks->{ Automatic,Automatic}; If[tic===Automatic,tic={Automatic,Automatic}]; If[tic===None,tic={None,None}]; If[tic[[1]]===Automatic,tic[[1]]=LinearScale[xmin,xmax]]; If[tic[[1]]=!=None,tic[[1]] = convertticks[tic[[1]],xmin,dx]]; tic ] convertticks[list_,xmin_,dx_]:= Module[{res=list,a,myind}, myind[x_] = ind[x,xmin,dx]; Do[ a = res[[i]]; If[Head[a]===List, res[[i]]= If[Head[a[[2]]]===List, res[[i]]=Join[{myind[a[[1]]],a[[1]]},Take[a,1-Length[a]]], res[[i]]=ReplacePart[a,myind[a[[1]]],1]], res[[i]]={myind[a],a} ], {i,Length[res]}]; res ] ind[x_,xmin_,dx_] := N[((x-xmin)/dx)+1]; fillit[xvars_,hues_,values_] := Module[{pointno = Length[xvars],nullv}, nullv = Table[0,{pointno-1}]; lines = Line[{xvars,values}//Transpose]; fills = {Drop[hues,-1], Map[Polygon, { {Drop[xvars,-1], nullv }//Transpose, {Drop[xvars,-1], Drop[values,-1]}//Transpose, {Drop[xvars, 1], Drop[values, 1]}//Transpose, {Drop[xvars, 1], nullv }//Transpose }//Transpose] }//Transpose; Graphics[ {fills,lines} ] ] End[] Protect[ArgColorPlot, ListArgColorPlot, CombinedPlot, ListCombinedPlot, NiceTicks] EndPackage[]