Weyl Group Orbits

Needs["Graphics`Animation`"];
<<"Lie.ma";

Weyl group of a2

a2d = dynkin["a2"];
a2EpsilonToAlpha = {{ Sqrt[2],   0         },	
					{-Sqrt[2]/2, Sqrt[6]/2}};
a2AlphaToLambda = Inverse[cartan["a2"]];
a2transf = Transpose[a2AlphaToLambda.a2EpsilonToAlpha];
a2roots = Graphics[{RGBColor[1,0,0],
	Line[{{0,0},#}]&/@a2EpsilonToAlpha}];

a2hyperplanes = Graphics[{Line[{{-Sqrt[3],1},{Sqrt[3],-1}}],
	Line[{{-Sqrt[3],-1},{Sqrt[3],1}}],Line[{{0,-2},{0,2}}]}];

a2o = orbitgraph[{1,1},a2d,a2transf];
a2graph = Graphics[{RGBColor[0,0,1],a2o[[1]]}];

Show[{a2hyperplanes,a2graph,a2roots},AspectRatio->Automatic];

a2t = orbittree[{1,1},a2d,a2transf];
a2tree = Graphics[{RGBColor[0,1,0],a2t[[1]]}];

Show[{a2hyperplanes,a2graph,a2tree,a2roots},AspectRatio->Automatic];

Weyl group of b2

b2d = dynkin["b2"];
b2EpsilonToAlpha = {{1,-1},{0,1}};
b2AlphaToLambda = Inverse[cartan["b2"]];
b2transf = Transpose[b2AlphaToLambda.b2EpsilonToAlpha];
b2roots = Graphics[{RGBColor[1,0,0],
	Line[{{0,0},#}]&/@b2EpsilonToAlpha}];

b2o = orbitgraph[{1,1},b2d,b2transf];
b2graph = Graphics[{RGBColor[0,0,1],b2o[[1]]}];

b2hyperplanes = Graphics[{Line[{{-2,0},{2,0}}],Line[{{0,-2},{0,2}}],
	Line[{{-1.5,1.5},{1.5,-1.5}}], Line[{{-1.5,-1.5},{1.5,1.5}}]}];

Show[{b2hyperplanes,b2graph,b2roots},AspectRatio->Automatic];

b2t = orbittree[{1,1},b2d,b2transf];
b2tree = Graphics[{RGBColor[0,1,0],b2t[[1]]}];

Show[{b2hyperplanes,b2graph,b2tree,b2roots},AspectRatio->Automatic];

Weyl group of a3

a3d = dynkin["a3"];
a3EpsilonToAlpha = {{ Sqrt[2],   0,         0          },	
					{-Sqrt[2]/2, Sqrt[6]/2, 0          },
					{ 0,        -Sqrt[6]/3, Sqrt[12]/3}};
a3AlphaToLambda = Inverse[cartan["a3"]];
a3transf = Transpose[a3AlphaToLambda.a3EpsilonToAlpha];
a3roots = Graphics3D[{RGBColor[1,0,0],
	Line[{{0,0,0},#}]&/@a3EpsilonToAlpha}];

a3o = orbitgraph[{1,1,1},a3d,a3transf];
a3graph = Graphics3D[{RGBColor[0,0,1],a3o[[1]]}];

Show[{a3roots,a3graph},ViewPoint->{0,5,1}, Boxed->False]

a3t = orbittree[{1,1,1},a3d,a3transf];
a3tree = Graphics3D[{RGBColor[0,1,0],a3t[[1]]}];

Show[{a3roots,a3graph,a3tree},ViewPoint->{1,3,5},Boxed->False]

SpinShow[{a3roots,a3graph,a3tree}]

Weyl group of b3

b3d = dynkin["b3"];
b3EpsilonToAlpha = {{1,-1,0},{0,1,-1},{0,0,1}};
b3AlphaToLambda = Inverse[cartan["b3"]];
b3roots = Graphics3D[{RGBColor[1,0,0],
	Line[{{0,0,0},#}]&/@b3EpsilonToAlpha}];
b3transf = Transpose[b3AlphaToLambda.b3EpsilonToAlpha];

b3g = orbitgraph[{1,1,1},b3d,b3transf];
b3graph = Graphics3D[{RGBColor[0,0,1],b3g[[1]]}];

Show[{b3graph, rb3},ViewPoint->{5,3,2}, Boxed->False];

b3t = orbittree[{1,1,1},b3d,b3transf];
b3tree = Graphics3D[{RGBColor[0,1,0],b3t[[1]]}];

Show[{b3roots,b3graph,b3tree},ViewPoint->{5,3,2},Boxed->False];

SpinShow[{b3roots,b3graph,b3tree}]