reduce-historical/r38/log/symmetry.rlg

Tue Apr 15 00:35:33 2008 run on win32

*** @ already defined as operator 
% test symmetry package
% implementation of theory of linear representations
% for small groups 

availablegroups();


{z2,k4,d3,d4,d5,d6,c3,c4,c5,c6,s4,a4}


printgroup(D4);


{id,rd4,rot2d4,rot3d4,sd4,srd4,sr2d4,sr3d4}


generators(D4);


{rd4,sd4}


charactertable(D4);


{{d4,{{id},1},{{rd4,rot3d4},1},{{rot2d4},1},{{sd4,sr2d4},1},{{sr3d4,srd4},1}},

 {d4,{{id},1},{{rd4,rot3d4},1},{{rot2d4},1},{{sd4,sr2d4},-1},{{sr3d4,srd4},-1}},

 {d4,{{id},1},{{rd4,rot3d4},-1},{{rot2d4},1},{{sd4,sr2d4},1},{{sr3d4,srd4},-1}},

 {d4,{{id},1},{{rd4,rot3d4},-1},{{rot2d4},1},{{sd4,sr2d4},-1},{{sr3d4,srd4},1}},

 {d4,{{id},2},{{rd4,rot3d4},0},{{rot2d4},-2},{{sd4,sr2d4},0},{{sr3d4,srd4},0}}}


characternr(D4,1);


{d4,{{id},1},{{rd4,rot3d4},1},{{rot2d4},1},{{sd4,sr2d4},1},{{sr3d4,srd4},1}}

characternr(D4,2);


{d4,{{id},1},{{rd4,rot3d4},1},{{rot2d4},1},{{sd4,sr2d4},-1},{{sr3d4,srd4},-1}}

characternr(D4,3);


{d4,{{id},1},{{rd4,rot3d4},-1},{{rot2d4},1},{{sd4,sr2d4},1},{{sr3d4,srd4},-1}}

characternr(D4,4);


{d4,{{id},1},{{rd4,rot3d4},-1},{{rot2d4},1},{{sd4,sr2d4},-1},{{sr3d4,srd4},1}}

characternr(D4,5);


{d4,{{id},2},{{rd4,rot3d4},0},{{rot2d4},-2},{{sd4,sr2d4},0},{{sr3d4,srd4},0}}

irreduciblereptable(D4);


{{d4,

  id=

  [1]

  ,

  rd4=

  [1]

  ,

  rot2d4=

  [1]

  ,

  rot3d4=

  [1]

  ,

  sd4=

  [1]

  ,

  srd4=

  [1]

  ,

  sr2d4=

  [1]

  ,

  sr3d4=

  [1]

  },

 {d4,

  id=

  [1]

  ,

  rd4=

  [1]

  ,

  rot2d4=

  [1]

  ,

  rot3d4=

  [1]

  ,

  sd4=

  [ - 1]

  ,

  srd4=

  [ - 1]

  ,

  sr2d4=

  [ - 1]

  ,

  sr3d4=

  [ - 1]

  },

 {d4,

  id=

  [1]

  ,

  rd4=

  [ - 1]

  ,

  rot2d4=

  [1]

  ,

  rot3d4=

  [ - 1]

  ,

  sd4=

  [1]

  ,

  srd4=

  [ - 1]

  ,

  sr2d4=

  [1]

  ,

  sr3d4=

  [ - 1]

  },

 {d4,

  id=

  [1]

  ,

  rd4=

  [ - 1]

  ,

  rot2d4=

  [1]

  ,

  rot3d4=

  [ - 1]

  ,

  sd4=

  [ - 1]

  ,

  srd4=

  [1]

  ,

  sr2d4=

  [ - 1]

  ,

  sr3d4=

  [1]

  },

 {d4,

  id=

  [1  0]
  [    ]
  [0  1]

  ,

  rd4=

  [ 0    1]
  [       ]
  [ - 1  0]

  ,

  rot2d4=

  [ - 1   0  ]
  [          ]
  [ 0     - 1]

  ,

  rot3d4=

  [0   - 1]
  [       ]
  [1   0  ]

  ,

  sd4=

  [1   0  ]
  [       ]
  [0   - 1]

  ,

  srd4=

  [0  1]
  [    ]
  [1  0]

  ,

  sr2d4=

  [ - 1  0]
  [       ]
  [ 0    1]

  ,

  sr3d4=

  [ 0     - 1]
  [          ]
  [ - 1   0  ]

  }}

irreduciblerepnr(D4,1);


{d4,

 id=

 [1]

 ,

 rd4=

 [1]

 ,

 rot2d4=

 [1]

 ,

 rot3d4=

 [1]

 ,

 sd4=

 [1]

 ,

 srd4=

 [1]

 ,

 sr2d4=

 [1]

 ,

 sr3d4=

 [1]

 }

irreduciblerepnr(D4,2);


{d4,

 id=

 [1]

 ,

 rd4=

 [1]

 ,

 rot2d4=

 [1]

 ,

 rot3d4=

 [1]

 ,

 sd4=

 [ - 1]

 ,

 srd4=

 [ - 1]

 ,

 sr2d4=

 [ - 1]

 ,

 sr3d4=

 [ - 1]

 }

irreduciblerepnr(D4,3);


{d4,

 id=

 [1]

 ,

 rd4=

 [ - 1]

 ,

 rot2d4=

 [1]

 ,

 rot3d4=

 [ - 1]

 ,

 sd4=

 [1]

 ,

 srd4=

 [ - 1]

 ,

 sr2d4=

 [1]

 ,

 sr3d4=

 [ - 1]

 }

irreduciblerepnr(D4,4);


{d4,

 id=

 [1]

 ,

 rd4=

 [ - 1]

 ,

 rot2d4=

 [1]

 ,

 rot3d4=

 [ - 1]

 ,

 sd4=

 [ - 1]

 ,

 srd4=

 [1]

 ,

 sr2d4=

 [ - 1]

 ,

 sr3d4=

 [1]

 }

irreduciblerepnr(D4,5);


{d4,

 id=

 [1  0]
 [    ]
 [0  1]

 ,

 rd4=

 [ 0    1]
 [       ]
 [ - 1  0]

 ,

 rot2d4=

 [ - 1   0  ]
 [          ]
 [ 0     - 1]

 ,

 rot3d4=

 [0   - 1]
 [       ]
 [1   0  ]

 ,

 sd4=

 [1   0  ]
 [       ]
 [0   - 1]

 ,

 srd4=

 [0  1]
 [    ]
 [1  0]

 ,

 sr2d4=

 [ - 1  0]
 [       ]
 [ 0    1]

 ,

 sr3d4=

 [ 0     - 1]
 [          ]
 [ - 1   0  ]

 }



rr:=mat((1,0,0,0,0),
        (0,0,1,0,0),
        (0,0,0,1,0),
        (0,0,0,0,1),
        (0,1,0,0,0));


      [1  0  0  0  0]
      [             ]
      [0  0  1  0  0]
      [             ]
rr := [0  0  0  1  0]
      [             ]
      [0  0  0  0  1]
      [             ]
      [0  1  0  0  0]



sp:=mat((1,0,0,0,0),
        (0,0,1,0,0),
        (0,1,0,0,0),
        (0,0,0,0,1),
        (0,0,0,1,0));


      [1  0  0  0  0]
      [             ]
      [0  0  1  0  0]
      [             ]
sp := [0  1  0  0  0]
      [             ]
      [0  0  0  0  1]
      [             ]
      [0  0  0  1  0]



rep:={D4,rD4=rr,sD4=sp};


rep := {d4,

        rd4=

        [1  0  0  0  0]
        [             ]
        [0  0  1  0  0]
        [             ]
        [0  0  0  1  0]
        [             ]
        [0  0  0  0  1]
        [             ]
        [0  1  0  0  0]

        ,

        sd4=

        [1  0  0  0  0]
        [             ]
        [0  0  1  0  0]
        [             ]
        [0  1  0  0  0]
        [             ]
        [0  0  0  0  1]
        [             ]
        [0  0  0  1  0]

        }


canonicaldecomposition(rep);


teta=2*teta1 + teta4 + teta5


character(rep);


{d4,{{id},5},{{rd4,rot3d4},1},{{rot2d4},1},{{sd4,sr2d4},1},{{sr3d4,srd4},3}}


symmetrybasis(rep,1);


[1   0 ]
[      ]
[    1 ]
[0  ---]
[    2 ]
[      ]
[    1 ]
[0  ---]
[    2 ]
[      ]
[    1 ]
[0  ---]
[    2 ]
[      ]
[    1 ]
[0  ---]
[    2 ]


symmetrybasis(rep,2);


symmetrybasis(rep,3);


symmetrybasis(rep,4);


[  0   ]
[      ]
[  1   ]
[ ---  ]
[  2   ]
[      ]
[  - 1 ]
[------]
[  2   ]
[      ]
[  1   ]
[ ---  ]
[  2   ]
[      ]
[  - 1 ]
[------]
[  2   ]


symmetrybasis(rep,5);


[  0       0   ]
[              ]
[  1       - 1 ]
[ ---    ------]
[  2       2   ]
[              ]
[  1       1   ]
[ ---     ---  ]
[  2       2   ]
[              ]
[  - 1     1   ]
[------   ---  ]
[  2       2   ]
[              ]
[  - 1     - 1 ]
[------  ------]
[  2       2   ]


symmetrybasispart(rep,5);


[  0   ]
[      ]
[  1   ]
[ ---  ]
[  2   ]
[      ]
[  1   ]
[ ---  ]
[  2   ]
[      ]
[  - 1 ]
[------]
[  2   ]
[      ]
[  - 1 ]
[------]
[  2   ]


allsymmetrybases(rep);


[1   0     0       0       0   ]
[                              ]
[    1     1       1       - 1 ]
[0  ---   ---     ---    ------]
[    2     2       2       2   ]
[                              ]
[    1     - 1     1       1   ]
[0  ---  ------   ---     ---  ]
[    2     2       2       2   ]
[                              ]
[    1     1       - 1     1   ]
[0  ---   ---    ------   ---  ]
[    2     2       2       2   ]
[                              ]
[    1     - 1     - 1     - 1 ]
[0  ---  ------  ------  ------]
[    2     2       2       2   ]




% Ritz matrix from Stiefel, Faessler p. 200
m:=mat((eps,a,a,a,a),
       (a  ,d,b,g,b),
       (a  ,b,d,b,g),
       (a  ,g,b,d,b),
       (a  ,b,g,b,d));


     [eps  a  a  a  a]
     [               ]
     [ a   d  b  g  b]
     [               ]
m := [ a   b  d  b  g]
     [               ]
     [ a   g  b  d  b]
     [               ]
     [ a   b  g  b  d]




diagonalize(m,rep);


[eps      2*a            0           0      0  ]
[                                              ]
[2*a  2*b + d + g        0           0      0  ]
[                                              ]
[ 0        0        - 2*b + d + g    0      0  ]
[                                              ]
[ 0        0             0         d - g    0  ]
[                                              ]
[ 0        0             0           0    d - g]



% eigenvalues are obvious. Eigenvectors may be obtained with
% the coordinate transformation matrix given by allsymmetrybases.

r1:=mat((0,1,0),
        (0,0,1),
        (1,0,0));


      [0  1  0]
      [       ]
r1 := [0  0  1]
      [       ]
      [1  0  0]



repC3:={C3,rC3=r1};


repc3 := {c3,rc3=

          [0  1  0]
          [       ]
          [0  0  1]
          [       ]
          [1  0  0]

          }


mC3:=mat((a,b,c),
         (c,a,b),
         (b,c,a));


       [a  b  c]
       [       ]
mc3 := [c  a  b]
       [       ]
       [b  c  a]



diagonalize(mC3,repC3);


[a + b + c              0                          0           ]
[                                                              ]
[                  2*a - b - c           sqrt(3)*b - sqrt(3)*c ]
[    0            -------------         -----------------------]
[                       2                          2           ]
[                                                              ]
[             - sqrt(3)*b + sqrt(3)*c         2*a - b - c      ]
[    0      --------------------------       -------------     ]
[                       2                          2           ]

 

% note difference between real and complex case

on complex;


diagonalize(mC3,repC3);


mat((a + b + c,0,0),

        i*sqrt(3)*b - i*sqrt(3)*c + 2*a - b - c
    (0,-----------------------------------------,0),
                           2

           - i*sqrt(3)*b + i*sqrt(3)*c + 2*a - b - c
    (0,0,--------------------------------------------))
                              2

 
off complex;



end;


Time for test: 88 ms, plus GC time: 9 ms