(* ::Package:: *)

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



(* ::Input::Initialization:: *)
SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\HigherRank"];
<< theta.m


(* ::Input::Initialization:: *)
hex=Table[{Cos[\[Alpha]],Sin[\[Alpha]]}/Cos[2\[Pi]/12]/2, {\[Alpha],2\[Pi]/12,2\[Pi],2\[Pi]/6}];
Subscript[PolyPlot, __][0]=Graphics[{}];
Subscript[PolyPlot, T1_,T2_][p_]:=Subscript[PolyPlot, Hexagon,T1,T2][p]
Subscript[PolyPlot, shape_,T1_,T2_][p_]:=Module[{crs,m1,m2,maxc,minc,s},
crs=CoefficientRules[T1^(m1=-Exponent[p,T1,Min]) T2^(m2=-Exponent[p,T2,Min]) p,{T1,T2}];
maxc=Max@Abs[Last/@crs];
minc=Min@Select[Abs[Last/@crs],#>0&];
If[minc==maxc,
s[_]=0,
s[c_]:=s[c]=N[Interpolation[{{Log@minc,1},{Log@maxc,0}}, InterpolationOrder->1][Log@c]]
];
Graphics[crs/.({x1_,x2_}->c_):>{
If[c==0,White,Lighter[If[c>0,Red,Blue], 0.88s[Abs@c]]],
Switch[shape,
Disk,Disk[({
 {1, -1/2},
 {0, Sqrt[3]/2}
}) . {x1+m1,x2+m2},0.5],
Hexagon,Polygon[(({
 {1, -1/2},
 {0, Sqrt[3]/2}
}) . {x1+m1,x2+m2}+#)&/@hex]
]
}]
]



