[BACK]Return to matrix_homotopies.adb CVS log [TXT][DIR] Up to [local] / OpenXM_contrib / PHC / Ada / Schubert

Annotation of OpenXM_contrib/PHC/Ada/Schubert/matrix_homotopies.adb, Revision 1.1

1.1     ! maekawa     1: with unchecked_deallocation;
        !             2:
        !             3: package body Matrix_Homotopies is
        !             4:
        !             5: -- INTERNAL DATA STRUCTURES :
        !             6:
        !             7:   type Matrix_Homotopy ( n,m : natural ) is record
        !             8:        start,target : Matrix(1..n,1..m);
        !             9:   end record;
        !            10:   type Link_to_Matrix_Homotopy is access Matrix_Homotopy;
        !            11:
        !            12:   type Matrix_Homotopy_Array is
        !            13:        array ( integer range <> ) of Link_to_Matrix_Homotopy;
        !            14:   type Link_to_Matrix_Homotopy_Array is access Matrix_Homotopy_Array;
        !            15:
        !            16: -- INTERNAL DATA :
        !            17:
        !            18:   mathom : Link_to_Matrix_Homotopy_Array;
        !            19:   curmat : natural;
        !            20:
        !            21: -- CREATORS :
        !            22:
        !            23:   procedure Init ( n : in natural ) is
        !            24:   begin
        !            25:     mathom := new Matrix_Homotopy_Array(1..n);
        !            26:     curmat := 0;
        !            27:   end Init;
        !            28:
        !            29:   procedure Add ( start,target : in Matrix ) is
        !            30:   begin
        !            31:     curmat := curmat+1;
        !            32:     mathom(curmat) := new Matrix_Homotopy(start'last(1),start'last(2));
        !            33:     mathom(curmat).start := start;
        !            34:     mathom(curmat).target := target;
        !            35:   end Add;
        !            36:
        !            37:   procedure Add_Start ( mapno : in natural; start : in Matrix ) is
        !            38:   begin
        !            39:     if mathom(mapno) = null
        !            40:      then mathom(mapno) := new Matrix_Homotopy(start'last(1),start'last(2));
        !            41:           curmat := mapno;
        !            42:     end if;
        !            43:     mathom(mapno).start := start;
        !            44:   end Add_Start;
        !            45:
        !            46:   procedure Add_Target ( mapno : in natural; target : in Matrix ) is
        !            47:   begin
        !            48:     if mathom(mapno) = null
        !            49:      then mathom(mapno) := new Matrix_Homotopy(target'last(1),target'last(2));
        !            50:           curmat := mapno;
        !            51:     end if;
        !            52:     mathom(mapno).target := target;
        !            53:   end Add_Target;
        !            54:
        !            55: -- SELECTORS :
        !            56:
        !            57:   function Empty ( mapno : natural ) return boolean is
        !            58:   begin
        !            59:     return (mathom(mapno) = null);
        !            60:   end Empty;
        !            61:
        !            62:   function Cardinality return natural is
        !            63:   begin
        !            64:     return curmat;
        !            65:   end Cardinality;
        !            66:
        !            67: -- EVALUATOR :
        !            68:
        !            69:   function Eval ( mapno : natural; t : Complex_Number ) return Matrix is
        !            70:
        !            71:     mho : Link_to_Matrix_Homotopy := mathom(mapno);
        !            72:     res : Matrix(1..mho.n,1..mho.m);
        !            73:     m1t : Complex_Number := Create(1.0) - t;
        !            74:
        !            75:   begin
        !            76:     if t = Create(0.0)
        !            77:      then res := mho.start;
        !            78:      elsif t = Create(1.0)
        !            79:          then res := mho.target;
        !            80:          else for i in res'range(1) loop
        !            81:                 for j in res'range(2) loop
        !            82:                   res(i,j) := m1t*mho.start(i,j) + t*mho.target(i,j);
        !            83:                 end loop;
        !            84:               end loop;
        !            85:     end if;
        !            86:     return res;
        !            87:   end Eval;
        !            88:
        !            89: -- DESTRUCTOR :
        !            90:
        !            91:   procedure Clear ( mh : in out Link_to_Matrix_Homotopy ) is
        !            92:
        !            93:     procedure free is
        !            94:          new unchecked_deallocation(Matrix_Homotopy,Link_to_Matrix_Homotopy);
        !            95:
        !            96:   begin
        !            97:     free(mh);
        !            98:   end Clear;
        !            99:
        !           100:   procedure Clear is
        !           101:
        !           102:     procedure free is
        !           103:       new unchecked_deallocation(Matrix_Homotopy_Array,
        !           104:                                  Link_to_Matrix_Homotopy_Array);
        !           105:
        !           106:   begin
        !           107:     for i in 1..curmat loop
        !           108:       Clear(mathom(i));
        !           109:     end loop;
        !           110:     free(mathom);
        !           111:   end Clear;
        !           112:
        !           113: end Matrix_Homotopies;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>