Guest User

Untitled

a guest
Jan 23rd, 2018
63
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 3.50 KB | None | 0 0
  1. (* ::Package:: *)
  2.  
  3. (* ::Code::Initialization::Plain:: *)
  4. superComplexContourPlot::usage="Plots a contour plot of a real expression in a complex variable,
  5. together with 1D projections of the depedence on the real/imaginary part of the variable.
  6. Arg 1: Expression to plot
  7. Arg 2: Variable to plot
  8. Opt 3: Plot label (def: '')
  9. Opt 5: {min real part, max real part} (def: {1,1})
  10. Opt 6: {min im part, max im part} (def: {1,1})";
  11.  
  12. Options[superComplexContourPlot]=Join[
  13. Options[ContourPlot],
  14. {
  15. centerColormap->False,
  16. centerColormapAt->0
  17. }
  18. ];
  19.  
  20. superComplexContourPlot[expr_,var_,label_String:"",xlim:{_?NumericQ, _?NumericQ}:{-1,1},ylim:{_?NumericQ, _?NumericQ}:{-1,1},opts:OptionsPattern[]]:=
  21. Module[{
  22. colorfunction,
  23. min,
  24. max,
  25. maxAbs,
  26. contourPlot,
  27. contourPlotLegend,
  28. real2DPlot,
  29. real2DPlotLegend,
  30. imaginary2DPlot,
  31. dimensions,
  32. padding
  33. },
  34.  
  35. (*we need to calculate the min/max to scale the color legend properly*)
  36. max=First@NMaximize[
  37. {Evaluate[expr/.var->(re+I im)], xlim[[1]]<=re<=xlim[[2]] && ylim[[1]]<=im<=ylim[[2]]},
  38. {re,im}
  39. ];
  40. min=First@NMinimize[
  41. {Evaluate[expr/.var->(re+I im)], xlim[[1]]<=re<=xlim[[2]] && ylim[[1]]<=im<=ylim[[2]]},
  42. {re,im}
  43. ];
  44. maxAbs=Max@@Abs/@{min,max};
  45.  
  46. colorfunction[value_]:=If[
  47. Evaluate@OptionValue["centerColormap"],
  48. ColorData["TemperatureMap"][(value-OptionValue["centerColormapAt"])/(2*maxAbs)+0.5],
  49. ColorData["TemperatureMap"][(value-min)/(max-min)]
  50. ];
  51.  
  52. dimensions = {300,290};
  53. padding = {{50(*l*),0(*r*)},{40(*b*),0(*t*)}};
  54.  
  55. contourPlot=ContourPlot[
  56. Evaluate[expr/.var->(re+I im)],
  57. {re,xlim[[1]],xlim[[2]]},
  58. {im,ylim[[1]],ylim[[2]]},
  59. ColorFunction->colorfunction,
  60. ColorFunctionScaling->False,
  61. PlotRangePadding->0,
  62. ImageSize->dimensions[[1]],
  63. ImagePadding->padding,
  64. FrameLabel->{Re[var],Im[var]},
  65. Evaluate@FilterRules[{opts},Options[ContourPlot]]
  66. ];
  67.  
  68.  
  69. contourPlotLegend=BarLegend[
  70. {colorfunction[#]&,{min,max}},
  71. LegendLayout->"Row",
  72. LegendLabel->label
  73. ];
  74.  
  75. (*will go on top*)
  76.  
  77. real2DPlot=Plot[
  78. Evaluate@Table[
  79. Evaluate[expr/.var->a I+x],
  80. {a,Range[ylim[[1]],ylim[[2]],Plus@@Abs/@ylim/4]}
  81. ],
  82. {x,xlim[[1]],xlim[[2]]},
  83. ImageSize -> {dimensions[[1]],Automatic},
  84. ImagePadding -> {{padding[[1,1]],0},{0,20}},
  85. PlotRangePadding -> 0,
  86. AspectRatio->1/2,
  87. Axes->{False,True},
  88. AxesLabel->{None,label}
  89. ];
  90.  
  91. real2DPlotLegend=SwatchLegend[
  92. 97,
  93. Style[#,10]&/@NumberForm[N@#,2]&/@Range[ylim[[1]],ylim[[2]],Plus@@Abs/@ylim/4],
  94. LegendLabel->Style[Im[var],10],
  95. LegendMarkers->{"\[FilledCircle]",10}
  96. ];
  97.  
  98. (*right*)
  99.  
  100. imaginary2DPlot=ParametricPlot[
  101. Evaluate@Table[
  102. {Evaluate[expr/.var->x I+a],x},
  103. {a,Range[xlim[[1]],xlim[[2]],Plus@@Abs/@xlim/4]}
  104. ],
  105. {x,ylim[[1]],ylim[[2]]},
  106. PlotStyle->Line,
  107. ImageSize -> {Automatic, dimensions[[2]]},
  108. ImagePadding -> {{0(*left*), 20(*right*)}, {padding[[2,1]](*bottom*),0(*top*)}},
  109. PlotRangePadding -> 0,
  110. AspectRatio->2,
  111. Axes->{True,False},
  112. PlotLegends->SwatchLegend[
  113. 97,
  114. Style[#,10]&/@NumberForm[N@#,2]&/@Range[xlim[[1]],xlim[[2]],Plus@@Abs/@xlim/4],
  115. LegendLabel->Style[Re[var],10],
  116. LegendMarkers->{"\[FilledCircle]",10}
  117. ],
  118. AxesLabel->{Rotate[label,Pi/2]}
  119. ];
  120.  
  121. Return@Grid[
  122. {
  123. {real2DPlot, real2DPlotLegend},
  124. {contourPlot, imaginary2DPlot},
  125. {DisplayForm@RowBox[{Spacer[padding[[1,1]]],contourPlotLegend}],Null}
  126. },
  127. Alignment -> {Left,Bottom},
  128. Spacings->{0,0},
  129. Frame->None
  130. ];
  131. ];
  132.  
  133.  
  134. (* ::Code::Initialization::Plain:: *)
  135. 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