Math 419H Homework 4 Demo
 Symmetric group G = S_3 acting on irreducible 2-dimensional representation V

(* Brackets on far right show run-blocks. To run a block, click on it and hit Shift+Enter. 
The blocks can be toggled open/closed by double-clicking its far-right bracket. *)

(* Generators s12 = (12), s23 = (23) 
Matrix = list of row-vectors, Transpose flips to column-vectors 
 Semi-colon after statement means result is not displayed *)
s12 = Transpose[{{0,1,0},{1,0,0},{0,0,1}}];
s23 = Transpose[{{1,0,0},{0,0,1},{0,1,0}}];
MatrixForm[s12]  (* Display matrices using MatrixForm *)
MatrixForm[s23]

Mat[X_]:=MatrixForm[X]  (* Define a function Mat of variable X *)
Mat[s23]
s23//Mat (* Another way to apply function Mat to input s23 *)

RG3={IdentityMatrix[3], s12, s23, s12.s23.s12, s12.s23, s23.s12};Table[ RG3[[i]]//Mat, {i,1,6} ]   (* RG3[[i]] = entry i of list RG3 *)

(* Gram-Schmidt othonormal basis {v0,v1,v2} 
compatible with invariant vector v0 = (1,1,1) *)
u={{1,1,1},{1,0,0},{0,1,0}};  (* Starting basis *)
w=Array[Null,3]; v=Array[Null,3,{0,2}]; (* Declare arrays *)

w[[1]]=u[[1]];  (* w[[i]] = orthogonal basis *)
w[[2]]= u[[2]]-(u[[2]].w[[1]])/(w[[1]].w[[1]]) w[[1]];
w[[3]]= u[[3]]-(u[[3]].w[[1]])/(w[[1]].w[[1]]) w[[1]]-(u[[3]].w[[2]])/(w[[2]].w[[2]]) w[[2]];

Do[v[[i]]=w[[i+1]]/Norm[w[[i+1]]], {i,0,2}];  (* v0,v1,v2 = normalize lengths *)
Print[ v[[0]],v[[1]],v[[2]] ]

(* Change of basis to v[[i]] to get 2-dim subrep V *)
M=Transpose[ {v[[0]],v[[1]],v[[2]]} ];
MatrixForm[M.Transpose[M]] (* M is orthogonal change-of-basis matrix *)
RG3v = Table[ Transpose[M].RG3[[i]].M, {i,6} ];
Table[  RG3v[[i]]//Mat,{i,6} ]

RG2= Table[ RG3v[[i,{2,3},{2,3}]],{i,6} ];  (* Extract lower-right 2 x 2 from RG3v[[i]] *)
Table[ RG2[[i]]//Mat,{i,6}]

e[i_]:=Table[KroneckerDelta[i-j],{j,3}] (* Standard basis of R^3 *)
a[i_]:= Sqrt[3/2]{e[i].v[[1]],e[i].v[[2]]}  (* Project standard vectors to triangle vertices in V, with scaling *)
Print[ a[1],a[2],a[3] ]

x={3,1}  (* Choose a vector x = 3 v1 + v2 in V *)
pts = Table[RG2[[i]].x , {i,6}]; (* Orbit G.x *)
polygon = ConvexHullMesh[pts]; (* Convex hull of orbit *)
aa[i_]:=Graphics[  Arrow[ {{0,0},3a[i]} ]  ] (* Show permuted vertices as arrows *)
Show[polygon, aa[1],aa[2],aa[3]]

aa[i_]:= Graphics[  {Red,Arrow[ {{0,0},3a[i]} ] } ]  (* Show permuted vertices as red arrows *)
Show[polygon, aa[1],aa[2],aa[3]]   
(* You can fiddle endlessly with graphics options *)

(* Orbits of the alternating group H = A_3 = C_3 *)
RH2=RG2[[{1,5,6}]]; (* Extract the id and 3-cycles from RG2 mattrices *)
x1={4,1} ; x2={3,2};(* Choose two vectors *)
pts = Table[RH2[[i]].x1, {i,3}]~Union~Table[RH2[[i]].x2, {i,3}]; (* Orbits G.x1 and G.x2*)
polygonH = ConvexHullMesh[pts]; (* Convex hull of orbit *)
Show[polygonH]