Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (* ::Package:: *)
- (* ::Code::Initialization::Plain:: *)
- superComplexContourPlot::usage="Plots a contour plot of a real expression in a complex variable,
- together with 1D projections of the depedence on the real/imaginary part of the variable.
- Arg 1: Expression to plot
- Arg 2: Variable to plot
- Opt 3: Plot label (def: '')
- Opt 5: {min real part, max real part} (def: {1,1})
- Opt 6: {min im part, max im part} (def: {1,1})";
- Options[superComplexContourPlot]=Join[
- Options[ContourPlot],
- {
- centerColormap->False,
- centerColormapAt->0
- }
- ];
- superComplexContourPlot[expr_,var_,label_String:"",xlim:{_?NumericQ, _?NumericQ}:{-1,1},ylim:{_?NumericQ, _?NumericQ}:{-1,1},opts:OptionsPattern[]]:=
- Module[{
- colorfunction,
- min,
- max,
- maxAbs,
- contourPlot,
- contourPlotLegend,
- real2DPlot,
- real2DPlotLegend,
- imaginary2DPlot,
- dimensions,
- padding
- },
- (*we need to calculate the min/max to scale the color legend properly*)
- max=First@NMaximize[
- {Evaluate[expr/.var->(re+I im)], xlim[[1]]<=re<=xlim[[2]] && ylim[[1]]<=im<=ylim[[2]]},
- {re,im}
- ];
- min=First@NMinimize[
- {Evaluate[expr/.var->(re+I im)], xlim[[1]]<=re<=xlim[[2]] && ylim[[1]]<=im<=ylim[[2]]},
- {re,im}
- ];
- maxAbs=Max@@Abs/@{min,max};
- colorfunction[value_]:=If[
- Evaluate@OptionValue["centerColormap"],
- ColorData["TemperatureMap"][(value-OptionValue["centerColormapAt"])/(2*maxAbs)+0.5],
- ColorData["TemperatureMap"][(value-min)/(max-min)]
- ];
- dimensions = {300,290};
- padding = {{50(*l*),0(*r*)},{40(*b*),0(*t*)}};
- contourPlot=ContourPlot[
- Evaluate[expr/.var->(re+I im)],
- {re,xlim[[1]],xlim[[2]]},
- {im,ylim[[1]],ylim[[2]]},
- ColorFunction->colorfunction,
- ColorFunctionScaling->False,
- PlotRangePadding->0,
- ImageSize->dimensions[[1]],
- ImagePadding->padding,
- FrameLabel->{Re[var],Im[var]},
- Evaluate@FilterRules[{opts},Options[ContourPlot]]
- ];
- contourPlotLegend=BarLegend[
- {colorfunction[#]&,{min,max}},
- LegendLayout->"Row",
- LegendLabel->label
- ];
- (*will go on top*)
- real2DPlot=Plot[
- Evaluate@Table[
- Evaluate[expr/.var->a I+x],
- {a,Range[ylim[[1]],ylim[[2]],Plus@@Abs/@ylim/4]}
- ],
- {x,xlim[[1]],xlim[[2]]},
- ImageSize -> {dimensions[[1]],Automatic},
- ImagePadding -> {{padding[[1,1]],0},{0,20}},
- PlotRangePadding -> 0,
- AspectRatio->1/2,
- Axes->{False,True},
- AxesLabel->{None,label}
- ];
- real2DPlotLegend=SwatchLegend[
- 97,
- Style[#,10]&/@NumberForm[N@#,2]&/@Range[ylim[[1]],ylim[[2]],Plus@@Abs/@ylim/4],
- LegendLabel->Style[Im[var],10],
- LegendMarkers->{"\[FilledCircle]",10}
- ];
- (*right*)
- imaginary2DPlot=ParametricPlot[
- Evaluate@Table[
- {Evaluate[expr/.var->x I+a],x},
- {a,Range[xlim[[1]],xlim[[2]],Plus@@Abs/@xlim/4]}
- ],
- {x,ylim[[1]],ylim[[2]]},
- PlotStyle->Line,
- ImageSize -> {Automatic, dimensions[[2]]},
- ImagePadding -> {{0(*left*), 20(*right*)}, {padding[[2,1]](*bottom*),0(*top*)}},
- PlotRangePadding -> 0,
- AspectRatio->2,
- Axes->{True,False},
- PlotLegends->SwatchLegend[
- 97,
- Style[#,10]&/@NumberForm[N@#,2]&/@Range[xlim[[1]],xlim[[2]],Plus@@Abs/@xlim/4],
- LegendLabel->Style[Re[var],10],
- LegendMarkers->{"\[FilledCircle]",10}
- ],
- AxesLabel->{Rotate[label,Pi/2]}
- ];
- Return@Grid[
- {
- {real2DPlot, real2DPlotLegend},
- {contourPlot, imaginary2DPlot},
- {DisplayForm@RowBox[{Spacer[padding[[1,1]]],contourPlotLegend}],Null}
- },
- Alignment -> {Left,Bottom},
- Spacings->{0,0},
- Frame->None
- ];
- ];
- (* ::Code::Initialization::Plain:: *)
- superComplexContourPlot[-1/3+(Abs[x]+1/10 Re[x]+Im[x]^3)/(1+Abs[x]),x,"My Expression",centerColormap->True,centerColormapAt->0]
Add Comment
Please, Sign In to add comment