Pensieve Header: Plotting 2-variable polynomials.

Print["Loading PolyPlot.m to plot 2-variable polynomials."]

Options[PolyPlot1]={Labeled->False};PolyPlot1[Δ_,OptionsPattern[]]:=Module[{Δ1,crs,m,maxc,minc,s,rect},
Δ1=PowerExpand@Expand@Δ;
rect={{0,0},{1,0},{1,1},{0,1}};
If[Δ1===0,Graphics[],
m=Max[-Exponent[Δ1,T,Min], Exponent[Δ1,T,Max]];
crs=CoefficientRules[(T^m)Δ1,{T}];
maxc=N@Log@Max@Abs[Last/@crs];
minc=N@Log@Min@Select[Abs[Last/@crs],#>0&];
If[minc==maxc,s[_]=0,s[c_]:=s[c]=(maxc-Log@c)/(maxc-minc)];
Graphics[crs/.({x_}->c_):>{
Lighter[Which[c==0, White,c>0, Red,c<0,Blue], 0.88s[Abs@c]],
Tooltip[Polygon[({x+m-1/2,0}+#)&/@rect],c (T^(x-m))],
If[Not@OptionValue[Labeled],{},{Black, FontSize->Scaled[(1/((m+1)(6+maxc)))],Text[c (T^(x-m)),{x+m,0.5}]}]
},AspectRatio->Min[1/5 ,1/(Sqrt[m+1])],ImagePadding->None,PlotRangePadding->None]
]];
Options[PolyPlot2]={Labeled->False, Shear->True};
PolyPlot2[θ_,OptionsPattern[]]:=Module[{θ1,crs,m1,m2,maxc,minc,s,stone,mat,p},
θ1=PowerExpand@Expand@θ;
If[θ1===0,Graphics[{White,Disk[]}],
If[OptionValue[Shear],
stone=Table[{Cos[α],Sin[α]}/Cos[2π/12]/2, {α,2π/12,2π,2π/6}];
mat=(({{1, -1/2}, {0, (Sqrt[3])/2}})),
stone={{1,1}, {-1,1},{-1,-1},{1,-1}}/2;
mat=IdentityMatrix[2];
];
m1=Max[-Exponent[θ1,(Subscript[T, 1]),Min], Exponent[θ1,(Subscript[T, 1]),Max]];
m2=Max[-Exponent[θ1,(Subscript[T, 2]),Min], Exponent[θ1,(Subscript[T, 2]),Max]];
crs=CoefficientRules[(Subscript[T, 1]^m1)(Subscript[T, 2]^m2)θ1,{(Subscript[T, 1]),(Subscript[T, 2])}];
maxc=N@Log@Max@Abs[Last/@crs];
minc=N@Log@Min@Select[Abs[Last/@crs],#>0&];
If[minc==maxc,s[_]=0,s[c_]:=s[c]=(maxc-Log@c)/(maxc-minc)];
Graphics[{(*{Yellow,Disk[{0,0},1+Cos[2π/12]Norm[{m1,m2}]/(Sqrt[2])]},*)
crs/.({x1_,x2_}->c_):>{
Lighter[Which[c==0, White,c>0, Red,c<0,Blue], 0.88s[Abs@c]],
p=mat.{x1-m1,x2-m2};
Tooltip[Polygon[(p+#)&/@stone],c (Subscript[T, 1]^(x1-m1))(Subscript[T, 2]^(x2-m2))] ,
If[Not@OptionValue[Labeled],{},{Black, FontSize->Scaled[(1/(Max[m1,m2](10+maxc)))],Text[c (Subscript[T, 1]^(x1-m1))(Subscript[T, 2]^(x2-m2)),p]}]
}
},ImagePadding->None,PlotRangePadding->None]
]];
Options[PolyPlot]={Labeled->False, ImageSize->Automatic};
PolyPlot[{Δ_,θ_},opts___Rule]:=GraphicsColumn[
{PolyPlot1[Δ,FilterRules[Join[{opts},Options[PolyPlot]],Options[PolyPlot1]]],
PolyPlot2[θ,FilterRules[Join[{opts},Options[PolyPlot]],Options[PolyPlot2]]]},
Spacings -> Scaled@0.08,ImagePadding->None,PlotRangePadding->None,
FilterRules[Join[{opts},Options[PolyPlot]],Options[GraphicsColumn]]
];

PolyPlot@{-1+(1/T)+T,-(1/(Subscript[T, 1]^2))-(Subscript[T, 1]^2)-(1/(Subscript[T, 2]^2))-(1/((Subscript[T, 1]^2) (Subscript[T, 2]^2)))+(1/((Subscript[T, 1]) (Subscript[T, 2]^2)))+(1/((Subscript[T, 1]^2) (Subscript[T, 2])))+((Subscript[T, 1])/(Subscript[T, 2]))+((Subscript[T, 2])/(Subscript[T, 1]))+(Subscript[T, 1]^2) (Subscript[T, 2])-(Subscript[T, 2]^2)+(Subscript[T, 1]) (Subscript[T, 2]^2)-(Subscript[T, 1]^2) (Subscript[T, 2]^2)}