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     ! 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;