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

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;