Return to matrix_homotopies.adb CVS log

Up to [local] / OpenXM_contrib / PHC / Ada / Schubert

Annotation of OpenXM_contrib/PHC/Ada/Schubert/matrix_homotopies.adb, Revision 1.1.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;