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
  
  
  
  A_n root systems
  
  (* A_n type Cartan matrix *)
  r := 3
  rt[i_] := UnitVector[r + 1, i] - UnitVector[r + 1, i + 1]
  b[i_, j_] := (2 Dot[rt[i], rt[j]])/Dot[rt[j], rt[j]]
  
  A := Table[b[i, j], {i, 1, r}, {j, 1, r}]
  
  Print["root vectors"]
  Table[rt[i], {i, 1, r}] // TableForm
  
  Print["Cartan matrix"]
  A // MatrixForm
  
  
  
  B_n root systems
  
  Clear[rt]
  (*B_r type Cartan matrix*)
  r := 4
  rt[i_] :=
   If[i < r, UnitVector[r, i] - UnitVector[r, 1 + i], UnitVector[r, r]]
  b[i_, j_] := (2 Dot[rt[i], rt[j]])/Dot[rt[j], rt[j]]
  A := Table[b[i, j], {i, 1, r}, {j, 1, r}]
  Print["root vectors"]
  Table[rt[i], {i, 1, r}] // TableForm
  Print["Cartan matrix"]
  A // MatrixForm
  
  
  
  C_n root systems
  
  Clear[rt]
  (*C_r type Cartan matrix*)
  r := 4
  rt[i_] :=
   If[i < r, UnitVector[r, i] - UnitVector[r, 1 + i], 2*UnitVector[r, r]]
  b[i_, j_] := (2 Dot[rt[i], rt[j]])/Dot[rt[j], rt[j]]
  A := Table[b[i, j], {i, 1, r}, {j, 1, r}]
  Print["root vectors"]
  Table[rt[i], {i, 1, r}] // TableForm
  Print["Cartan matrix"]
  A // MatrixForm
  
  
  
  D_n root systems
  
  Clear[rt]
  (*D_r type Cartan matrix*)
  r := 6
  rt[i_] :=
   If[i < r, UnitVector[r, i] - UnitVector[r, 1 + i],
    UnitVector[r, r - 1] + UnitVector[r, r]]
  b[i_, j_] := (2 Dot[rt[i], rt[j]])/Dot[rt[j], rt[j]]
  A := Table[b[i, j], {i, 1, r}, {j, 1, r}]
  Print["root vectors"]
  Table[rt[i], {i, 1, r}] // TableForm
  Print["Cartan matrix"]
  A // MatrixForm
  
  
  
  G2 root system
  
  Clear[r, rt]
  (*G_ 2 type Cartan matrix*)
  r := 2
  rt[1] := {1, -1, 0}
  rt[2] := {-1, 2, -1}
  Print["root vectors"]
  Table[rt[i], {i, 1, r}] // TableForm
  A := Table[b[i, j], {i, 1, r}, {j, 1, r}]
  A // MatrixForm
  rt[1]
  rt[2] - rt[1]
  
  
  
  F4 root system
  
  Clear[r, rt]
  (*F_ 4 type Cartan matrix*)
  Clear[rt]
  r := 4
  rt[1] := {1, -1, 0, 0}
  rt[2] := {0, 1, -1, 0}
  rt[3] := {0, 0, 1, 0}
  rt[4] := {-1, -1, -1, -1}/2
  b[i_, j_] := (2 Dot[rt[i], rt[j]])/Dot[rt[j], rt[j]]
  A := Table[b[i, j], {i, 1, r}, {j, 1, r}]
  Print["root vectors"]
  Table[rt[i], {i, 1, r}]
  Print["Cartan matrix"]
  A // MatrixForm
  
  
  
  
  E_6 root system
  
  Clear[rt]
  (*E_ 6 type Cartan matrix*)
  r := 6
  rt[1] := {0, 0, 0, 0, 0, 0, 0, 1, \[Minus]1}
  rt[2] := {0, 0, 0, 0, 0, 0, 1, -1, 0}
  rt[3] := {1, -2, 1, -2, 1, 1, -2, 1, 1}/3
  rt[4] := {0, 0, 0, 1, -1, 0, 0, 0, 0}
  rt[5] := {0, 0, 0, 0, 1, -1, 0, 0, 0}
  rt[6] := {0, 1, -1, 0, 0, 0, 0, 0, 0}
  b[i_, j_] := (2 Dot[rt[i], rt[j]])/Dot[rt[j], rt[j]]
  A := Table[b[i, j], {i, 1, r}, {j, 1, r}]
  Print["root vectors"]
  Table[rt[i], {i, 1, r}] // TableForm
  Print["Cartan matrix"]
  A // MatrixForm
  
  
  http://en.wikipedia.org/wiki/E6_(mathematics)
  
  
  
  E_7 root system
  
  Clear[rt]
  (*E_ 7 type Cartan matrix*)
  r := 7
  alp := Sum[UnitVector[r + 1, i]/2, {i, 1, 4}] -
    Sum[UnitVector[r + 1, i]/2, {i, 5, 8}]
  rt[i_] :=
   Piecewise[{{UnitVector[r + 1, i + 2] - UnitVector[r + 1, 1 + i],
      i < 7}, {alp, i == 7}}, {i, 1, r}]
  b[i_, j_] := (2 Dot[rt[i], rt[j]])/Dot[rt[j], rt[j]]
  A := Table[b[i, j], {i, 1, r}, {j, 1, r}]
  Print["root vectors"]
  Table[rt[i], {i, 1, r}] // TableForm
  Print["Cartan matrix"]
  A // MatrixForm
  
  
      * http://en.wikipedia.org/wiki/E7_%28mathematics%29
  
  
  
  E_8 root system
  
  Clear[rt]
  (*E_ 8 type Cartan matrix*)
  alp := -Sum[UnitVector[r, i]/2, {i, 1, r}]
  r := 8
  rt[i_] :=
   Piecewise[{{UnitVector[r, i] - UnitVector[r, 1 + i],
      i < 7}, {UnitVector[r, i] + UnitVector[r, i - 1], i == 7}, {alp,
      i == 8}}, {i, Range[r]}]
  b[i_, j_] := (2 Dot[rt[i], rt[j]])/Dot[rt[j], rt[j]]
  A := Table[b[i, j], {i, 1, r}, {j, 1, r}]
  Print["root vectors"]
  Table[rt[i], {i, 1, r}] // TableForm
  Print["Cartan matrix"]
  A // MatrixForm
  
  
  
  related items
  
      * dilogarithm and Nahm's conjecture (mathematica)