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

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;