Root systems and Dynkin diagrams(mathematica)

• Root Systems and Dynkin diagrams
      * http://en.wikipedia.org/wiki/root_systems
      * http://en.wikipedia.org/wiki/Dynkin_diagram

 

 

 

Clear[Unirt, rt, r, alp]
Clear[A, B, CC, DD, E6, E7, E8, F, G]
(* choose the one of types *)
ty := B
(* define the rank *)
r := 4
Unirt[A, i_] := UnitVector[r + 1, i] - UnitVector[r + 1, i + 1]
Unirt[B, i_] :=
 If[i < r, UnitVector[r, i] - UnitVector[r, 1 + i], UnitVector[r, r]]
Unirt[CC, i_] :=
 If[i < r, UnitVector[r, i] - UnitVector[r, 1 + i], 2*UnitVector[r, r]]
Unirt[DD, i_] :=
 If[i < r, UnitVector[r, i] - UnitVector[r, 1 + i],
  UnitVector[r, r - 1] + UnitVector[r, r]]
Unirt[G, 1] := {1, -1, 0}
Unirt[G, 2] := {-1, 2, -1}
Unirt[F, 1] := {1, -1, 0, 0}
Unirt[F, 2] := {0, 1, -1, 0}
Unirt[F, 3] := {0, 0, 1, 0}
Unirt[F, 4] := {-1, -1, -1, -1}/2
Unirt[E6, 1] := {0, 0, 0, 0, 0, 0, 0, 1, \[Minus]1}
Unirt[E6, 2] := {0, 0, 0, 0, 0, 0, 1, -1, 0}
Unirt[E6, 3] := {1, -2, 1, -2, 1, 1, -2, 1, 1}/3
Unirt[E6, 4] := {0, 0, 0, 1, -1, 0, 0, 0, 0}
Unirt[E6, 5] := {0, 0, 0, 0, 1, -1, 0, 0, 0}
Unirt[E6, 6] := {0, 1, -1, 0, 0, 0, 0, 0, 0}
Unirt[E7, i_] :=
 Piecewise[{{UnitVector[r + 1, i + 2] - UnitVector[r + 1, 1 + i],
    i < 7}, {{1/2, 1/2, 1/2, 1/2, -(1/2), -(1/2), -(1/2), -(1/2)},
    i == 7}}, {i, 1, r}]
Unirt[E8, i_] :=
 Piecewise[{{UnitVector[r, i] - UnitVector[r, 1 + i],
    i < 7}, {UnitVector[r, i] + UnitVector[r, i - 1],
    i == 7}, {{-(1/2), -(1/2), -(1/2), -(1/2), -(1/2), -(1/2), -(1/
      2), -(1/2)}, i == 8}}, {i, Range[r]}]
rt[i_] := Unirt[ty, i]
b[i_, j_] := (2 Dot[rt[i], rt[j]])/Dot[rt[j], rt[j]]
CA := Table[b[i, j], {i, 1, r}, {j, 1, r}]
Print["root vectors of ", ty, r]
Table[rt[i], {i, 1, r}] // TableForm
Print["Cartan matrix of ", ty, r]
CA // MatrixForm
Print["Dynkin diagram of ", ty, r]
GraphPlot[CA, VertexLabeling -> True]