File: [local] / OpenXM_contrib / PHC / Ada / Schubert / ts_posets.adb (download)
Revision 1.1.1.1 (vendor branch), Sun Oct 29 17:45:33 2000 UTC (23 years, 11 months ago) by maekawa
Branch: PHC, MAIN
CVS Tags: v2, maekawa-ipv6, RELEASE_1_2_3, RELEASE_1_2_2_KNOPPIX_b, RELEASE_1_2_2_KNOPPIX, RELEASE_1_2_2, RELEASE_1_2_1, HEAD Changes since 1.1: +0 -0
lines
Import the second public release of PHCpack.
OKed by Jan Verschelde.
|
with text_io,integer_io; use text_io,integer_io;
with Communications_with_User; use Communications_with_User;
with Brackets,Brackets_io; use Brackets,Brackets_io;
with Localization_Posets; use Localization_Posets;
with Localization_Posets_io; use Localization_Posets_io;
with Drivers_for_Input_Planes; use Drivers_for_Input_Planes;
procedure ts_posets is
-- DESCRIPTION :
-- Test on the construction of localization posets.
function Determine_Root ( m,p : natural ) return Node is
-- DESCRIPTION :
-- Proposes the trivial root to the user, allowing the user to
-- modify this choice.
root : Node(p) := Trivial_Root(m,p);
ans : character;
begin
loop
put("Top and bottom pivots of root are ");
put(root.top); put(" and ");
put(root.bottom); put_line(".");
put("Level of the root : "); put(root.level,1); new_line;
put("Do you want to use another root ? (y/n) "); get(ans);
exit when (ans /= 'y');
put("Give top pivots : "); get(root.top);
put("Give bottom pivots : "); get(root.bottom);
put("Give level of root : "); get(root.level);
end loop;
return root;
end Determine_Root;
procedure Write_Poset
( file : in file_type;
lnkroot : in Link_to_Node; m,p,q : in natural ) is
-- DESCRIPTION :
-- Creates the posets and writes them onto the file.
nq : constant natural := m*p + q*(m+p);
level_poset : Array_of_Nodes(0..nq);
index_poset : Array_of_Array_of_Nodes(0..nq);
nbp : natural;
begin
level_poset := Create_Leveled_Poset(lnkroot);
Count_Roots(level_poset);
index_poset := Create_Indexed_Poset(level_poset);
put(file,index_poset);
nbp := Root_Count_Sum(level_poset);
put(file,"The number of paths : "); put(file,nbp,1); new_line(file);
end Write_Poset;
procedure Create_Top_Hypersurface_Poset ( m,p : in natural ) is
-- DESCRIPTION :
-- Create the poset by incrementing only top pivots.
root : Node(p) := Trivial_Root(m,p);
lnkroot : Link_to_Node := new Node'(root);
begin
Top_Create(lnkroot,m+p);
put_line("The poset created from the top : ");
Write_Poset(Standard_Output,lnkroot,m,p,0);
end Create_Top_Hypersurface_Poset;
procedure Create_Top_Hypersurface_Poset ( m,p,q : in natural ) is
-- DESCRIPTION :
-- Create the poset by incrementing only top pivots.
root : Node(p) := Trivial_Root(m,p,q);
lnkroot : Link_to_Node := new Node'(root);
begin
Q_Top_Create(lnkroot,root.bottom(p),m+p);
put_line("The poset created from the top : ");
Write_Poset(Standard_Output,lnkroot,m,p,q);
end Create_Top_Hypersurface_Poset;
procedure Create_Bottom_Hypersurface_Poset ( m,p : in natural ) is
-- DESCRIPTION :
-- Create the poset by decrementing only bottom pivots.
root : Node(p) := Trivial_Root(m,p);
lnkroot : Link_to_Node := new Node'(root);
begin
Bottom_Create(lnkroot);
put_line("The poset created from the bottom : ");
Write_Poset(Standard_Output,lnkroot,m,p,0);
end Create_Bottom_Hypersurface_Poset;
procedure Create_Bottom_Hypersurface_Poset ( m,p,q : in natural ) is
-- DESCRIPTION :
-- Create the poset by decrementing only bottom pivots.
root : Node(p) := Trivial_Root(m,p,q);
lnkroot : Link_to_Node := new Node'(root);
begin
Q_Bottom_Create(lnkroot,m+p);
put_line("The poset created from the bottom : ");
Write_Poset(Standard_Output,lnkroot,m,p,q);
end Create_Bottom_Hypersurface_Poset;
procedure Create_Mixed_Hypersurface_Poset ( m,p : in natural ) is
-- DESCRIPTION :
-- Create the poset by incrementing top and decrementing bottom pivots.
root : Node(p) := Trivial_Root(m,p);
lnkroot : Link_to_Node := new Node'(root);
begin
Top_Bottom_Create(lnkroot,m+p);
put_line("The poset created in a mixed fashion : ");
Write_Poset(Standard_Output,lnkroot,m,p,0);
end Create_Mixed_Hypersurface_Poset;
procedure Create_Mixed_Hypersurface_Poset ( m,p,q : in natural ) is
-- DESCRIPTION :
-- Create the poset by incrementing top and decrementing bottom pivots.
root : Node(p) := Trivial_Root(m,p,q);
lnkroot : Link_to_Node := new Node'(root);
begin
Q_Top_Bottom_Create(lnkroot,root.bottom(p),m+p);
put_line("The poset created in a mixed fashion : ");
Write_Poset(Standard_Output,lnkroot,m,p,q);
end Create_Mixed_Hypersurface_Poset;
procedure Create_Top_General_Poset ( m,p : in natural ) is
-- DESCRIPTION :
-- Creates a poset for counting general subspace intersections,
-- by consistently incrementing the top pivots.
root : Node(p) := Trivial_Root(m,p);
lnkroot : Link_to_Node := new Node'(root);
codim : constant Bracket := Read_Codimensions(m,p,0);
begin
Top_Create(lnkroot,codim,m+p);
put_line("The poset created from the top : ");
Write_Poset(Standard_Output,lnkroot,m,p,0);
end Create_Top_General_Poset;
procedure Create_Bottom_General_Poset ( m,p : in natural ) is
-- DESCRIPTION :
-- Creates a poset for counting general subspace intersections,
-- by consistently incrementing the top pivots.
root : Node(p) := Trivial_Root(m,p);
lnkroot : Link_to_Node := new Node'(root);
codim : constant Bracket := Read_Codimensions(m,p,0);
begin
Bottom_Create(lnkroot,codim);
put_line("The poset created from the bottom : ");
Write_Poset(Standard_Output,lnkroot,m,p,0);
end Create_Bottom_General_Poset;
procedure Create_Mixed_General_Poset ( m,p : in natural ) is
-- DESCRIPTION :
-- Creates a poset for counting general subspace intersections,
-- by incrementing the top and decrementing the bottom pivots.
root : Node(p) := Trivial_Root(m,p);
lnkroot : Link_to_Node := new Node'(root);
codim : constant Bracket := Read_Codimensions(m,p,0);
begin
Top_Bottom_Create(lnkroot,codim,m+p);
put_line("The poset created in a mixed fashion : ");
Write_Poset(Standard_Output,lnkroot,m,p,0);
end Create_Mixed_General_Poset;
procedure Create_Top_General_Poset ( m,p,q : in natural ) is
-- DESCRIPTION :
-- Creates a poset for counting general subspace intersections,
-- by consistently incrementing the top pivots.
root : Node(p) := Trivial_Root(m,p,q);
lnkroot : Link_to_Node := new Node'(root);
codim : constant Bracket := Read_Codimensions(m,p,q);
begin
Q_Top_Create(lnkroot,codim,root.bottom(p),m+p);
put_line("The poset created from the top : ");
Write_Poset(Standard_Output,lnkroot,m,p,q);
end Create_Top_General_Poset;
procedure Create_Bottom_General_Poset ( m,p,q : in natural ) is
-- DESCRIPTION :
-- Creates a poset for counting general subspace intersections,
-- by consistently incrementing the top pivots.
root : Node(p) := Trivial_Root(m,p,q);
lnkroot : Link_to_Node := new Node'(root);
codim : constant Bracket := Read_Codimensions(m,p,q);
begin
Q_Bottom_Create(lnkroot,codim,m+p);
put_line("The poset created from the bottom : ");
Write_Poset(Standard_Output,lnkroot,m,p,q);
end Create_Bottom_General_Poset;
procedure Create_Mixed_General_Poset ( m,p,q : in natural ) is
-- DESCRIPTION :
-- Creates a poset for counting general subspace intersections,
-- by incrementing the top and decrementing the bottom pivots.
root : Node(p) := Trivial_Root(m,p,q);
lnkroot : Link_to_Node := new Node'(root);
codim : constant Bracket := Read_Codimensions(m,p,q);
begin
Q_Top_Bottom_Create(lnkroot,codim,root.bottom(p),m+p);
put_line("The poset created in a mixed fashion : ");
Write_Poset(Standard_Output,lnkroot,m,p,q);
end Create_Mixed_General_Poset;
procedure Test_Root_Counts
( file : in file_type;
m,p,q : in natural; codim : in Bracket; bug : out boolean ) is
-- DESCRIPTION :
-- Computes the root count in various ways for the given vector
-- of co-dimensions. Compares the results and reports bugs.
mpq : constant natural := m*p + q*(m+p);
top_root0,bot_root0,mix_root0 : Node(p);
lnk_top_root0 : Link_to_Node := new Node'(top_root0);
lnk_bot_root0 : Link_to_Node := new Node'(bot_root0);
lnk_mix_root0 : Link_to_Node := new Node'(mix_root0);
top_poset0,bot_poset0,mix_poset0 : Array_of_Nodes(0..mpq);
top_rootq,bot_rootq,mix_rootq : Node(p);
lnk_top_rootq : Link_to_Node := new Node'(top_rootq);
lnk_bot_rootq : Link_to_Node := new Node'(bot_rootq);
lnk_mix_rootq : Link_to_Node := new Node'(mix_rootq);
top_posetq,bot_posetq,mix_posetq : Array_of_Nodes(0..mpq);
begin
bug := false;
if q = 0
then top_root0 := Trivial_Root(m,p);
bot_root0 := Trivial_Root(m,p);
mix_root0 := Trivial_Root(m,p);
lnk_top_root0 := new Node'(top_root0);
lnk_bot_root0 := new Node'(bot_root0);
lnk_mix_root0 := new Node'(mix_root0);
Top_Create(lnk_top_root0,codim,m+p);
Bottom_Create(lnk_bot_root0,codim);
Top_Bottom_Create(lnk_mix_root0,codim,m+p);
top_poset0 := Create_Leveled_Poset(lnk_top_root0);
bot_poset0 := Create_Leveled_Poset(lnk_bot_root0);
mix_poset0 := Create_Leveled_Poset(lnk_mix_root0);
Count_Roots(top_poset0);
Count_Roots(bot_poset0);
Count_Roots(mix_poset0);
end if;
top_rootq := Trivial_Root(m,p,q);
bot_rootq := Trivial_Root(m,p,q);
mix_rootq := Trivial_Root(m,p,q);
lnk_top_rootq := new Node'(top_rootq);
lnk_bot_rootq := new Node'(bot_rootq);
lnk_mix_rootq := new Node'(mix_rootq);
Q_Top_Create(lnk_top_rootq,codim,top_rootq.bottom(p),m+p);
Q_Bottom_Create(lnk_bot_rootq,codim,m+p);
Q_Top_Bottom_Create(lnk_mix_rootq,codim,mix_rootq.bottom(p),m+p);
top_posetq := Create_Leveled_Poset(lnk_top_rootq);
bot_posetq := Create_Leveled_Poset(lnk_bot_rootq);
mix_posetq := Create_Leveled_Poset(lnk_mix_rootq);
Count_Roots(top_posetq);
Count_Roots(bot_posetq);
Count_Roots(mix_posetq);
if q = 0
then
put(file,top_poset0(mpq).roco,1);
if top_poset0(mpq).roco = bot_poset0(mpq).roco
then
put(file," = ");
put(file,bot_poset0(mpq).roco,1); bug := false;
if bot_poset0(mpq).roco = mix_poset0(mpq).roco
then
bug := false;
put(file," = "); put(file,mix_poset0(mpq).roco,1);
else
bug := true;
put(file," <> "); put(file,mix_poset0(mpq).roco,1);
put_line(file," BUG !!!");
put_line(file,"The poset created incrementing top pivots : ");
Write_Poset(file,lnk_top_root0,m,p,q);
put_line(file,"The poset created decrementing bottom pivots : ");
Write_Poset(file,lnk_bot_root0,m,p,q);
put_line(file,"The poset created in a mixed fashion : ");
Write_Poset(file,lnk_mix_root0,m,p,q);
end if;
else
bug := true;
put(file," <> "); put(file,bot_poset0(mpq).roco,1);
put_line(file," BUG !!!");
put_line(file,"The poset created incrementing top pivots : ");
Write_Poset(file,lnk_top_root0,m,p,q);
put_line(file,"The poset created decrementing bottom pivots : ");
Write_Poset(file,lnk_bot_root0,m,p,q);
end if;
end if;
if q = 0
then
if top_posetq(mpq).roco /= top_poset0(mpq).roco
then
bug := true;
put(file," <> "); put(file,top_posetq(mpq).roco,1);
put_line(file," BUG !!!");
put_line(file,"The poset created without q = 0 : ");
Write_Poset(file,lnk_top_root0,m,p,q);
put_line(file,"The poset created with q = 0 : ");
Write_Poset(file,lnk_bot_rootq,m,p,q);
else
put(file," = ");
end if;
end if;
if not bug
then
put(file,top_posetq(mpq).roco,1);
if top_posetq(mpq).roco = bot_posetq(mpq).roco
then
put(file," = ");
put(file,bot_posetq(mpq).roco,1); bug := false;
if bot_posetq(mpq).roco = mix_posetq(mpq).roco
then
bug := false;
put(file," = "); put(file,mix_posetq(mpq).roco,1); new_line(file);
else
bug := true;
put(file," <> "); put(file,mix_posetq(mpq).roco,1);
put_line(file," BUG !!!");
put_line(file,"The poset created incrementing top pivots : ");
Write_Poset(file,lnk_top_rootq,m,p,q);
put_line(file,"The poset created decrementing bottom pivots : ");
Write_Poset(file,lnk_bot_rootq,m,p,q);
put_line(file,"The poset created in a mixed fashion : ");
Write_Poset(file,lnk_mix_rootq,m,p,q);
end if;
else
bug := true;
put(file," <> "); put(file,bot_posetq(mpq).roco,1);
put_line(file," BUG !!!");
put_line(file,"The poset created incrementing top pivots : ");
Write_Poset(file,lnk_top_rootq,m,p,q);
put_line(file,"The poset created decrementing bottom pivots : ");
Write_Poset(file,lnk_bot_rootq,m,p,q);
end if;
end if;
Clear(top_poset0); Clear(bot_poset0); Clear(mix_poset0);
Clear(top_posetq); Clear(bot_posetq); Clear(mix_posetq);
end Test_Root_Counts;
procedure Enumerate_Partitions
( file : in file_type; m,p,q : in natural ) is
-- DESCRIPTION :
-- Test the root counts for all partitions of m*p + q*(m+p).
-- The results are written on file.
n : constant natural := m*p + q*(m+p);
accu : Bracket(1..n);
bug : boolean := false;
procedure Enumerate ( k,nk : in natural ) is
begin
if nk = 0
then put(file,n,1); put(file," = ");
for i in 1..k-2 loop
put(file,accu(i),1); put(file," + ");
end loop;
put(file,accu(k-1),1); put(file," : ");
Test_Root_Counts(file,m,p,q,accu(1..k-1),bug);
else for i in 1..nk loop
exit when (i > m);
accu(k) := i;
Enumerate(k+1,nk-i);
exit when bug;
end loop;
end if;
end Enumerate;
begin
Enumerate(1,n);
end Enumerate_Partitions;
procedure Main is
m,p,q : natural;
ans : character;
file : file_type;
begin
loop
new_line;
put_line("MENU for posets for counting p-planes in (m+p)-space : ");
put_line(" 0. exit this program.");
put_line("-------- the case q = 0 ------------------------------------");
put_line(" 1. k_i == 1 consistently incrementing the top pivots.");
put_line(" 2. consistently decrementing the bottom pivots.");
put_line(" 3. mixed top-bottom sequence for poset creation.");
put_line(" 4. k_i >= 1 consistently incrementing the top pivots.");
put_line(" 5. consistently decrementing the bottom pivots.");
put_line(" 6. mixed top-bottom sequence for poset creation.");
put_line(" 7. Enumerate all partitions of m*p and test root counts.");
put_line("-------- the case q >= 0 -----------------------------------");
put_line(" 8. k_i == 1 consistently incrementing top pivots.");
put_line(" 9. consistently decrementing bottom pivots.");
put_line(" A. mixed top-bottom sequence for pivots.");
put_line(" B. k_i >= 1 consistently incrementing top pivots.");
put_line(" C. consistently decrementing bottom pivots.");
put_line(" D. mixed top-bottom sequence for pivots.");
put_line(" E. Test root counts for all partitions of m*p + q*(m+p).");
put_line("------------------------------------------------------------");
put("Type 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, A, B, C, D, or E to choose : ");
Ask_Alternative(ans,"0123456789ABCDE");
exit when ans = '0';
if ans = '7' or ans = 'E'
then new_line;
put_line("Reading the name of the output file.");
Read_Name_and_Create_File(file);
end if;
new_line;
put("Give p, the number of entries in bracket : "); get(p);
put("Give m, the complementary dimension : "); get(m);
new_line;
case ans is
when '1' => Create_Top_Hypersurface_Poset(m,p);
when '2' => Create_Bottom_Hypersurface_Poset(m,p);
when '3' => Create_Mixed_Hypersurface_Poset(m,p);
when '4' => Create_Top_General_Poset(m,p);
when '5' => Create_Bottom_General_Poset(m,p);
when '6' => Create_Mixed_General_Poset(m,p);
when '7' => Enumerate_Partitions(file,m,p,0);
when '8' => put("Give q, the degree of the maps : "); get(q);
Create_Top_Hypersurface_Poset(m,p,q);
when '9' => put("Give q, the degree of the maps : "); get(q);
Create_Bottom_Hypersurface_Poset(m,p,q);
when 'A' => put("Give q, the degree of the maps : "); get(q);
Create_Mixed_Hypersurface_Poset(m,p,q);
when 'B' => put("Give q, the degree of the maps : "); get(q);
Create_Top_General_Poset(m,p,q);
when 'C' => put("Give q, the degree of the maps : "); get(q);
Create_Bottom_General_Poset(m,p,q);
when 'D' => put("Give q, the degree of the maps : "); get(q);
Create_Mixed_General_Poset(m,p,q);
when 'E' => put("Give q, the degree of the maps : "); get(q);
Enumerate_Partitions(file,m,p,q);
when others => put_line("Option not recognized. Please try again.");
end case;
end loop;
end Main;
begin
new_line;
put_line("Test on localization posets for linear subspace intersections.");
Main;
end ts_posets;