Return to lists_of_vectors_utilities.adb CVS log

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

Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Implift/lists_of_vectors_utilities.adb, Revision 1.1

1.1     ! maekawa     1: with Standard_Integer_Norms;             use Standard_Integer_Norms;
        !             2: with Standard_Integer_Matrices;          use Standard_Integer_Matrices;
        !             3: with Standard_Integer_Linear_Solvers;    use Standard_Integer_Linear_Solvers;
        !             4:
        !             5: package body Lists_of_Vectors_Utilities is
        !             6:
        !             7:   procedure Compute_Normal ( v : in VecVec; n : out Link_to_Vector;
        !             8:                              deg : out natural ) is
        !             9:
        !            10:     d : Link_to_Vector renames v(v'last);
        !            11:     im : matrix(d'range,d'range);
        !            12:     res : Link_to_Vector;
        !            13:     cnt : integer;
        !            14:
        !            15:   begin
        !            16:     res := new Vector(d'range);
        !            17:     cnt := im'first(1);
        !            18:     for i in v'first..(v'last-1) loop
        !            19:       for j in im'range(2) loop
        !            20:         im(cnt,j) := v(i)(j) - d(j);
        !            21:       end loop;
        !            22:       cnt := cnt + 1;
        !            23:     end loop;
        !            24:     for i in cnt..im'last(1) loop
        !            25:       for j in im'range(2) loop
        !            26:         im(i,j) := 0;
        !            27:       end loop;
        !            28:     end loop;
        !            29:     Upper_Triangulate(im);
        !            30:     cnt := 1;
        !            31:     for k in im'first(1)..im'last(1)-1 loop
        !            32:       cnt := cnt*im(k,k);
        !            33:     end loop;
        !            34:     if cnt < 0
        !            35:      then deg := -cnt;
        !            36:      else deg := cnt;
        !            37:     end if;
        !            38:     Scale(im);
        !            39:     Solve0(im,res.all);
        !            40:     Normalize(res.all);
        !            41:     n := res;
        !            42:   end Compute_Normal;
        !            43:
        !            44:   function Compute_Normal ( v : VecVec ) return Link_to_Vector is
        !            45:
        !            46:     deg : natural;
        !            47:     res : Link_to_Vector;
        !            48:
        !            49:   begin
        !            50:     Compute_Normal(v,res,deg);
        !            51:     return res;
        !            52:   end Compute_Normal;
        !            53:
        !            54:   function Pointer_to_Last ( l : List ) return List is
        !            55:
        !            56:     res : List := l;
        !            57:
        !            58:   begin
        !            59:     if not Is_Null(res)
        !            60:      then while not Is_Null(Tail_Of(res)) loop
        !            61:             res := Tail_Of(res);
        !            62:           end loop;
        !            63:     end if;
        !            64:     return res;
        !            65:   end Pointer_to_Last;
        !            66:
        !            67:   procedure Move_to_Front ( l : in out List; v : in Vector ) is
        !            68:
        !            69:     tmp : List := l;
        !            70:     found : boolean := false;
        !            71:     first,lv : Link_to_Vector;
        !            72:
        !            73:   begin
        !            74:     while not Is_Null(tmp) loop
        !            75:       lv := Head_Of(tmp);
        !            76:       if Equal(lv.all,v)
        !            77:        then found := true;
        !            78:        else tmp := Tail_Of(tmp);
        !            79:       end if;
        !            80:       exit when found;
        !            81:     end loop;
        !            82:     if found
        !            83:      then
        !            84:        first := Head_Of(l);
        !            85:        if first /= lv
        !            86:         then
        !            87:           lv.all := first.all;  Set_Head(tmp,lv);
        !            88:           first.all := v;       Set_Head(l,first);
        !            89:        end if;
        !            90:     end if;
        !            91:   end Move_to_Front;
        !            92:
        !            93:   function Difference ( l1,l2 : List ) return List is
        !            94:
        !            95:     res,res_last : List;
        !            96:     tmp : List := l1;
        !            97:     pt : Link_to_Vector;
        !            98:
        !            99:   begin
        !           100:     while not Is_Null(tmp) loop
        !           101:       pt := Head_Of(tmp);
        !           102:       if not Is_In(l2,pt.all)
        !           103:        then Append(res,res_last,pt.all);
        !           104:       end if;
        !           105:       tmp := Tail_Of(tmp);
        !           106:     end loop;
        !           107:     return res;
        !           108:   end Difference;
        !           109:
        !           110:   function Different_Points ( l : List ) return List is
        !           111:
        !           112:     tmp,res,res_last : List;
        !           113:
        !           114:   begin
        !           115:     tmp := l;
        !           116:     while not Is_Null(tmp) loop
        !           117:       Append_Diff(res,res_last,Head_Of(tmp).all);
        !           118:       tmp := Tail_Of(tmp);
        !           119:     end loop;
        !           120:     return res;
        !           121:   end Different_Points;
        !           122:
        !           123:   procedure Remove_Duplicates ( l : in out List ) is
        !           124:
        !           125:     res : List := Different_Points(l);
        !           126:
        !           127:   begin
        !           128:     Deep_Clear(l);
        !           129:     l := res;
        !           130:   end Remove_Duplicates;
        !           131:
        !           132: end Lists_of_Vectors_Utilities;