Return to symmetry_group.adb CVS log

Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Symmetry

Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Symmetry/symmetry_group.adb, Revision 1.1.1.1

1.1       maekawa     1: with Standard_Integer_Vectors;           use Standard_Integer_Vectors;
                      2:
                      3: package body Symmetry_Group is
                      4:
                      5:   use Lists_of_Permutations;
                      6:
                      7:   procedure Add ( l : in out List_of_Permutations; p : in Permutation ) is
                      8:
                      9:     lp : Link_To_Permutation;
                     10:
                     11:   begin
                     12:     lp := new Vector'(Vector(p));
                     13:     Construct(lp,l);
                     14:   end Add;
                     15:
                     16:   procedure Append ( first,last : in out List_of_Permutations;
                     17:                      p : in Permutation ) is
                     18:
                     19:     lp : Link_To_Permutation;
                     20:
                     21:   begin
                     22:     lp := new Vector'(Vector(p));
                     23:     Append(first,last,lp);
                     24:   end Append;
                     25:
                     26:   function Union ( a,b : List_of_Permutations ) return List_of_Permutations is
                     27:
                     28:     tmp,res : List_of_Permutations;
                     29:
                     30:   begin
                     31:     res := a;
                     32:     tmp := b;
                     33:     while not Is_Null(tmp) loop
                     34:       Add(res,Permutation(Head_Of(tmp).all));
                     35:       tmp := Tail_Of(tmp);
                     36:     end loop;
                     37:     return res;
                     38:   end Union;
                     39:
                     40:   function SymGrp ( n : natural ) return List_of_Permutations is
                     41:
                     42:     sn : List_of_Permutations;
                     43:     p : Vector(1..n);
                     44:
                     45:   begin
                     46:     for k in p'range loop
                     47:       p(k) := k;
                     48:     end loop;
                     49:     for k in reverse 1..n loop
                     50:       p(k) := 1; p(1) := k;
                     51:       declare
                     52:         lp : Link_to_Permutation := new Vector'(p);
                     53:       begin
                     54:         Construct(lp,sn);
                     55:       end;
                     56:       p(1) := 1; p(k) := k;
                     57:     end loop;
                     58:     return sn;
                     59:   end SymGrp;
                     60:
                     61:   function Generate ( g : List_of_Permutations ) return List_of_Permutations is
                     62:
                     63:     res : List_Of_Permutations;
                     64:     at_end : boolean;
                     65:
                     66:    -- IMPORTANT :
                     67:    --   This routine assumes that permutations are added to the front
                     68:    --   of the list !!!
                     69:
                     70:   begin
                     71:     if not Is_Null(g)
                     72:      then declare
                     73:             p1,p2,r : Permutation(Head_Of(g).all'range);
                     74:             temp1,temp2,nwres : List_Of_Permutations;
                     75:             nb,cnt : natural;
                     76:           begin
                     77:            -- INITIALIZE res :
                     78:             temp1 := g;
                     79:             while not Is_Null(temp1) loop
                     80:               p1 := Permutation(Head_Of(temp1).all);
                     81:               Add(res,p1);
                     82:               temp1 := Tail_Of(temp1);
                     83:             end loop;
                     84:            -- CONSTRUCT res :
                     85:            at_end := false;
                     86:            nb := Length_Of(res);
                     87:             while not at_end loop
                     88:               temp1 := g; --res;
                     89:               while not Is_Null(temp1) loop
                     90:                 p1 := Permutation(Head_Of(temp1).all);
                     91:                 cnt := 0;
                     92:                 temp2 := res;
                     93:                 while cnt < nb loop
                     94:                   p2 := Permutation(Head_Of(temp2).all);
                     95:                   r := p1*p2;
                     96:                   if not Is_In(res,r) and not Is_In(nwres,r)
                     97:                    then Add(nwres,r);
                     98:                   end if;
                     99:                   cnt := cnt + 1;
                    100:                   temp2 := Tail_Of(temp2);
                    101:                 end loop;
                    102:                 temp1 := Tail_Of(temp1);
                    103:               end loop;
                    104:               nb := Length_Of(nwres);
                    105:              at_end := (nb = 0);
                    106:              if not at_end
                    107:                then temp2 := nwres;
                    108:                     while not Is_Null(temp2) loop
                    109:                       Add(res,Permutation(Head_Of(temp2).all));
                    110:                       temp2 := Tail_Of(temp2);
                    111:                     end loop;
                    112:                     Clear(nwres);
                    113:               end if;
                    114:             end loop;
                    115:           end;
                    116:     end if;
                    117:     return res;
                    118:   end Generate;
                    119:
                    120: -- SELECTORS :
                    121:
                    122:   function Number (l : List_Of_Permutations) return natural is
                    123:   begin
                    124:     return Length_Of(l);
                    125:   end Number;
                    126:
                    127:   function Is_In ( l : List_of_Permutations; p : Permutation )
                    128:                  return boolean is
                    129:
                    130:     tmp : List_Of_Permutations := l;
                    131:
                    132:   begin
                    133:     while not Is_Null(tmp) loop
                    134:       if Equal(Permutation(Head_Of(tmp).all),p)
                    135:        then return true;
                    136:        else tmp := Tail_Of(tmp);
                    137:       end if;
                    138:     end loop;
                    139:     return false;
                    140:   end Is_In;
                    141:
                    142:   procedure Iterator ( l : in List_of_Permutations ) is
                    143:
                    144:     tmp : List_Of_Permutations := l;
                    145:     cont : boolean;
                    146:
                    147:   begin
                    148:     cont := false;
                    149:     while not Is_Null(tmp) loop
                    150:       Process(Permutation(Head_Of(tmp).all),cont);
                    151:       exit when not cont;
                    152:       tmp := Tail_Of(tmp);
                    153:     end loop;
                    154:   end Iterator;
                    155:
                    156: -- DESTRUCTOR :
                    157:
                    158:   procedure Clear ( l : in out List_of_Permutations ) is
                    159:   begin
                    160:     Lists_of_Permutations.Clear(Lists_of_Permutations.List(l));
                    161:   end Clear;
                    162:
                    163: end Symmetry_Group;