Return to ts_conint.adb CVS log

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

Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Stalift/ts_conint.adb, Revision 1.1

1.1     ! maekawa     1: with text_io,integer_io;                 use text_io,integer_io;
        !             2: with Communications_with_User;           use Communications_with_User;
        !             3: with Numbers_io;                         use Numbers_io;
        !             4: with Standard_Integer_Vectors;           use Standard_Integer_Vectors;
        !             5: with Standard_Integer_Vectors_io;        use Standard_Integer_Vectors_io;
        !             6: with Standard_Integer_Matrices;          use Standard_Integer_Matrices;
        !             7: with Standard_Integer_Matrices_io;       use Standard_Integer_Matrices_io;
        !             8: with Standard_Complex_Poly_Systems;      use Standard_Complex_Poly_Systems;
        !             9: with Standard_Complex_Poly_Systems_io;   use Standard_Complex_Poly_Systems_io;
        !            10: with Power_Lists;                        use Power_Lists;
        !            11: with Lists_of_Integer_Vectors;           use Lists_of_Integer_Vectors;
        !            12: with Lists_of_Integer_Vectors_io;        use Lists_of_Integer_Vectors_io;
        !            13: with Arrays_of_Integer_Vector_Lists;     use Arrays_of_Integer_Vector_Lists;
        !            14: with Arrays_of_Integer_Vector_Lists_io;  use Arrays_of_Integer_Vector_Lists_io;
        !            15: with Inner_Normal_Cones;                 use Inner_Normal_Cones;
        !            16: with Normal_Cone_Intersections;          use Normal_Cone_Intersections;
        !            17: with Normal_Cone_Intersections_io;       use Normal_Cone_Intersections_io;
        !            18:
        !            19: procedure ts_conint is
        !            20:
        !            21: -- DESCRIPTION :
        !            22: --   Test on the operations of the package Normal_Cone_Intersections.
        !            23:
        !            24:   procedure Compute_Intersection_Matrix
        !            25:               ( supports : in Array_of_Lists; g : in List;
        !            26:                 x : Vector; i : in natural ) is
        !            27:
        !            28:   -- DESCRIPTION :
        !            29:   --   Computes and displays the intersection matrix on screen.
        !            30:   --   Lists all complementary columns.
        !            31:
        !            32:     ans : character;
        !            33:     n1 : constant natural := supports'length - 1;
        !            34:     mg : constant natural := Length_Of(g);
        !            35:     nc : constant natural := Number_of_Cones(supports,i);
        !            36:     ima : Intersection_Matrix(n1,mg,nc);
        !            37:
        !            38:     procedure Write_Selection ( cols : in Vector; continue : out boolean ) is
        !            39:     begin
        !            40:       put("selected columns : "); put(cols); new_line;
        !            41:       continue := true;
        !            42:     end Write_Selection;
        !            43:     procedure Write_Complementary_Columns is
        !            44:       new Complementary_Columns(Write_Selection);
        !            45:
        !            46:     procedure Check_Selection ( cols : in Vector; continue : out boolean ) is
        !            47:
        !            48:       part : Array_of_Lists(cols'range);
        !            49:
        !            50:     begin
        !            51:       put("selected columns : "); put(cols); new_line;
        !            52:       part := Partition(ima,cols,g);
        !            53:       put_line("The partition of the set of generators : "); put(part);
        !            54:       if Partition_in_Union(part,supports,i,cols)
        !            55:        then put_line("The partition is contained in the union of cones.");
        !            56:        else put_line("The partition is NOT contained in the union of cones.");
        !            57:       end if;
        !            58:      -- Deep_Clear(part);
        !            59:       put("The point "); put(x); put(" is ");
        !            60:       if Contained_in_Union(supports,i,g,ima,cols)   -- double check
        !            61:        then put("contained in the union of columns ");
        !            62:        else put("not contained in the union of columns ");
        !            63:       end if;
        !            64:       put(cols); put_line(".");
        !            65:       continue := true;
        !            66:     end Check_Selection;
        !            67:     procedure Check_Complementary_Columns is
        !            68:       new Complementary_Columns(Check_Selection);
        !            69:
        !            70:   begin
        !            71:     ima := Create(supports,g,i);
        !            72:     put(ima);
        !            73:     put_line("The complementary columns :");
        !            74:     Write_Complementary_Columns(ima);
        !            75:     put("Do you want to check the complementary columns ? (y/n) ");
        !            76:     get(ans);
        !            77:     if ans = 'y'
        !            78:      then Check_Complementary_Columns(ima);
        !            79:     end if;
        !            80:   end Compute_Intersection_Matrix;
        !            81:
        !            82:   procedure Test_Intersection_Matrix ( p : in Poly_Sys ) is
        !            83:
        !            84:   -- DESCRIPTION :
        !            85:   --   Allows the computation of intersection matrix of cones
        !            86:   --   on the points in the support lists of the polynomial system.
        !            87:
        !            88:     supp : Array_of_Lists(p'range) := Create(p);
        !            89:     genx : List;
        !            90:     ind : natural;
        !            91:     x : Vector(p'range) := (p'range => 0);
        !            92:     ans : character;
        !            93:
        !            94:   begin
        !            95:     loop
        !            96:       new_line;
        !            97:       put("Give a vector : "); get(x);
        !            98:       put("Give an index : "); get(ind);
        !            99:       genx := Generators(supp(ind),x);
        !           100:       put("The generators of the normal cone at "); put(x); put_line(" :");
        !           101:       put(genx);
        !           102:       Compute_Intersection_Matrix(supp,genx,x,ind);
        !           103:       put("Do you want more tests ? (y/n) "); Ask_Yes_or_No(ans);
        !           104:       exit when ans /= 'y';
        !           105:     end loop;
        !           106:   end Test_Intersection_Matrix;
        !           107:
        !           108:   procedure Main is
        !           109:
        !           110:     p : Link_to_Poly_Sys;
        !           111:
        !           112:   begin
        !           113:     new_line;
        !           114:     put_line("Testing the intersection of normal cones.");
        !           115:     new_line;
        !           116:     get(p);
        !           117:     Test_Intersection_Matrix(p.all);
        !           118:   end Main;
        !           119:
        !           120: begin
        !           121:   Main;
        !           122: end ts_conint;