Return to permutations_of_faces.adb CVS log

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

Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Symmetry/permutations_of_faces.adb, Revision 1.1

1.1     ! maekawa     1: with Standard_Integer_Vectors;           use Standard_Integer_Vectors;
        !             2: with Standard_Integer_VecVecs;           use Standard_Integer_VecVecs;
        !             3: with Permute_Operations;                 use Permute_Operations;
        !             4:
        !             5: package body Permutations_of_Faces is
        !             6:
        !             7:   function Invariant ( f : Face; p : Permutation ) return boolean is
        !             8:
        !             9:     fp : Face := Permute(f,p);
        !            10:     res : boolean := Is_Equal(f,fp);
        !            11:
        !            12:   begin
        !            13:     Deep_Clear(fp);
        !            14:     return res;
        !            15:   end Invariant;
        !            16:
        !            17:   function Invariant_Lifted ( f : Face; p : Permutation ) return boolean is
        !            18:
        !            19:     fp : Face := Permute_Lifted(f,p);
        !            20:     res : boolean := Is_Equal(f,fp);
        !            21:
        !            22:   begin
        !            23:     Deep_Clear(fp);
        !            24:     return res;
        !            25:   end Invariant_Lifted;
        !            26:
        !            27:   function Permute ( f : Face; p : Permutation ) return Face is
        !            28:
        !            29:     res : Face := new VecVec(f'range);
        !            30:
        !            31:   begin
        !            32:     for i in f'range loop
        !            33:       res(i) := new Vector'(p*f(i).all);
        !            34:     end loop;
        !            35:     return res;
        !            36:   end Permute;
        !            37:
        !            38:   function Permute_Lifted ( f : Face; p : Permutation ) return Face is
        !            39:
        !            40:     res : Face := new VecVec(f'range);
        !            41:
        !            42:   begin
        !            43:     for i in f'range loop
        !            44:       declare
        !            45:         pt : constant Vector := f(i)(f(i)'first..f(i)'last-1);
        !            46:       begin
        !            47:         res(i) := new Vector(f(i)'range);
        !            48:         res(i)(pt'range) := p*pt;
        !            49:         res(i)(res(i)'last) := f(i)(f(i)'last);
        !            50:       end;
        !            51:     end loop;
        !            52:     return res;
        !            53:   end Permute_Lifted;
        !            54:
        !            55:   function Permutable ( f1,f2 : Face ) return boolean is
        !            56:
        !            57:     res : boolean;
        !            58:
        !            59:   begin
        !            60:     for i in f1'range loop
        !            61:       res := false;
        !            62:       for j in f2'range loop
        !            63:         res := Permutable(f1(i).all,f2(j).all);
        !            64:         exit when res;
        !            65:       end loop;
        !            66:       exit when not res;
        !            67:     end loop;
        !            68:     return res;
        !            69:   end Permutable;
        !            70:
        !            71:   function Permutable_Lifted ( f1,f2 : Face ) return boolean is
        !            72:
        !            73:     res : boolean;
        !            74:
        !            75:   begin
        !            76:     for i in f1'range loop
        !            77:       res := false;
        !            78:       for j in f2'range loop
        !            79:         if f1(i)(f1(i)'last) = f2(j)(f2(j)'last)  -- same lifting
        !            80:          then res := Permutable(f1(i)(f1(i)'first..f1(i)'last-1),
        !            81:                                 f2(j)(f2(j)'first..f2(j)'last-1));
        !            82:         end if;
        !            83:         exit when res;
        !            84:       end loop;
        !            85:       exit when not res;
        !            86:     end loop;
        !            87:     return res;
        !            88:   end Permutable_Lifted;
        !            89:
        !            90:   function Permutable ( f1 : Face; f2 : Faces ) return boolean is
        !            91:
        !            92:     tmp : Faces := f2;
        !            93:
        !            94:   begin
        !            95:     while not Is_Null(tmp) loop
        !            96:       if Permutable(f1,Head_Of(tmp))
        !            97:        then return true;
        !            98:        else tmp := Tail_Of(tmp);
        !            99:       end if;
        !           100:     end loop;
        !           101:   end Permutable;
        !           102:
        !           103:   function Permutable_Lifted ( f1 : Face; f2 : Faces ) return boolean is
        !           104:
        !           105:     tmp : Faces := f2;
        !           106:
        !           107:   begin
        !           108:     while not Is_Null(tmp) loop
        !           109:       if Permutable_Lifted(f1,Head_Of(tmp))
        !           110:        then return true;
        !           111:        else tmp := Tail_Of(tmp);
        !           112:       end if;
        !           113:     end loop;
        !           114:     return false;
        !           115:   end Permutable_Lifted;
        !           116:
        !           117: end Permutations_of_Faces;