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

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;