Complex contour Plot together with 1D Plot projections of real and imaginary part

superComplexContourPlot.wl

(* ::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]

examples here: http://www.lieret.net/2018/01/12/supercontour/