Return to common_faces_of_polytope.adb CVS log

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

Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Dynlift/common_faces_of_polytope.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:
        !             4: package body Common_Faces_of_Polytope is
        !             5:
        !             6:   function Have_Common_Point ( l : List; v : VecVec ) return boolean is
        !             7:
        !             8:   -- DESCRIPTION :
        !             9:   --   Returns true if at least one point in v belongs to the list l.
        !            10:
        !            11:   begin
        !            12:     for i in v'range loop
        !            13:       if Is_In(l,v(i).all)
        !            14:        then return true;
        !            15:       end if;
        !            16:     end loop;
        !            17:     return false;
        !            18:   end Have_Common_Point;
        !            19:
        !            20:   function Is_Neighbor1 ( l : List; fc : Face ) return boolean is
        !            21:   begin
        !            22:     return Have_Common_Point(l,fc.all);
        !            23:   end Is_Neighbor1;
        !            24:
        !            25:   function Is_Neighbor ( l : List; fc : Face ) return boolean is
        !            26:
        !            27:     cntnotin : natural := 0;
        !            28:        -- counts the points in the face fc that are not in the list l
        !            29:
        !            30:   begin
        !            31:     for i in fc'range loop
        !            32:       if not Is_In(l,fc(i).all)
        !            33:        then cntnotin := cntnotin + 1;
        !            34:             if cntnotin > 1
        !            35:              then return false;
        !            36:             end if;
        !            37:       end if;
        !            38:     end loop;
        !            39:     return true;
        !            40:   end Is_Neighbor;
        !            41:
        !            42:   function Neighboring_Faces ( mic : Mixed_Cell; fs : Faces; i : natural )
        !            43:                              return Faces is
        !            44:
        !            45:     tmp : Faces := fs;
        !            46:     res,res_last : Faces;
        !            47:
        !            48:   begin
        !            49:     while not Is_Null(tmp) loop
        !            50:       declare
        !            51:         fc : Face := Head_Of(tmp);
        !            52:       begin
        !            53:         if Is_Neighbor(mic.pts(i),fc)
        !            54:          then Append(res,res_last,fc);
        !            55:         end if;
        !            56:         tmp := Tail_Of(tmp);
        !            57:       end;
        !            58:     end loop;
        !            59:     return res;
        !            60:   end Neighboring_Faces;
        !            61:
        !            62:   function Neighboring_Faces ( mic : Mixed_Cell; afs : Array_of_Faces )
        !            63:                              return Array_of_Faces is
        !            64:
        !            65:     res : Array_of_Faces(afs'range);
        !            66:
        !            67:   begin
        !            68:     for i in res'range loop
        !            69:       res(i) := Neighboring_Faces(mic,afs(i),i);
        !            70:     end loop;
        !            71:     return res;
        !            72:   end Neighboring_Faces;
        !            73:
        !            74: end Common_Faces_of_Polytope;