(* ::Package:: *)

(************************************************************************)\012(* This file was generated automatically by the Mathematica front end.  *)\012(* It contains Initialization cells from a Notebook file, which         *)\012(* typically will have the same name as this file except ending in      *)\012(* ".nb" instead of ".m".                                               *)\012(*                                                                      *)\012(* This file is intended to be loaded into the Mathematica kernel using *)\012(* the package loading commands Get or Needs.  Doing so is equivalent   *)\012(* to using the Evaluate Initialization Cells menu command in the front *)\012(* end.                                                                 *)\012(*                                                                      *)\012(* DO NOT EDIT THIS FILE.  This entire file is regenerated              *)\012(* automatically each time the parent Notebook file is saved in the     *)\012(* Mathematica front end.  Any changes you make to this file will be    *)\012(* overwritten.                                                         *)\012(************************************************************************)\012\012

(* ::Input::Initialization:: *)
Print["Loading PolyPlot.m from http://drorbn.net/mv26/ap to plot 2-variable polynomials."]


(* ::Input::Initialization:: *)
Options[PolyPlot1]={Labeled->False};PolyPlot1[\[CapitalDelta]_,OptionsPattern[]]:=Module[{\[CapitalDelta]1,crs,m,maxc,minc,s,rect},
\[CapitalDelta]1=PowerExpand@Expand@\[CapitalDelta];
rect={{0,0},{1,0},{1,1},{0,1}};
If[\[CapitalDelta]1===0,Graphics[],
m=Max[-Exponent[\[CapitalDelta]1,T,Min], Exponent[\[CapitalDelta]1,T,Max]];
crs=CoefficientRules[T^m \[CapitalDelta]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[\[Theta]_,OptionsPattern[]]:=Module[{\[Theta]1,crs,m1,m2,maxc,minc,s,stone,mat,p},
\[Theta]1=PowerExpand@Expand@\[Theta];
If[\[Theta]1===0,Graphics[{White,Disk[]}],
If[OptionValue[Shear],
stone=Table[{Cos[\[Alpha]],Sin[\[Alpha]]}/Cos[2\[Pi]/12]/2, {\[Alpha],2\[Pi]/12,2\[Pi],2\[Pi]/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[\[Theta]1,Subscript[T, 1],Min], Exponent[\[Theta]1,Subscript[T, 1],Max]];
m2=Max[-Exponent[\[Theta]1,Subscript[T, 2],Min], Exponent[\[Theta]1,Subscript[T, 2],Max]];
crs=CoefficientRules[\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(m1\)] 
\*SubsuperscriptBox[\(T\), \(2\), \(m2\)] \[Theta]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\[Pi]/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 \!\(\*SubsuperscriptBox[\(T\), \(1\), \(x1 - m1\)]\) \!\(\*SubsuperscriptBox[\(T\), \(2\), \(x2 - m2\)]\)] ,
If[Not@OptionValue[Labeled],{},{Black, FontSize->Scaled[1/(Max[m1,m2](10+maxc))],Text[c \!\(\*SubsuperscriptBox[\(T\), \(1\), \(x1 - m1\)]\) \!\(\*SubsuperscriptBox[\(T\), \(2\), \(x2 - m2\)]\),p]}]
}
},ImagePadding->None,PlotRangePadding->None]
]];
Options[PolyPlot]={Labeled->False, ImageSize->Automatic};
PolyPlot[{\[CapitalDelta]_,\[Theta]_},opts___Rule]:=GraphicsColumn[
{PolyPlot1[\[CapitalDelta],FilterRules[Join[{opts},Options[PolyPlot]],Options[PolyPlot1]]],
PolyPlot2[\[Theta],FilterRules[Join[{opts},Options[PolyPlot]],Options[PolyPlot2]]]},
Spacings -> Scaled@0.08,ImagePadding->None,PlotRangePadding->None,
FilterRules[Join[{opts},Options[PolyPlot]],Options[GraphicsColumn]]
];



