File: [local] / OpenXM_contrib / PHC / Ada / Schubert / pieri_trees_io.adb (download)
Revision 1.1.1.1 (vendor branch), Sun Oct 29 17:45:32 2000 UTC (23 years, 8 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 integer_io; use integer_io;
with Standard_Natural_Vectors_io; use Standard_Natural_Vectors_io;
with Brackets_io; use Brackets_io;
package body Pieri_Trees_io is
type Boolean_Array is array ( integer range <> ) of boolean;
procedure put ( nd : in Pieri_Node ) is
begin
put(Standard_Output,nd);
end put;
procedure put ( file : in file_type; nd : in Pieri_Node ) is
begin
put(file,nd.node);
put(file,"(c="); put(file,nd.c,1);
put(file,",i="); put(file,nd.i,1);
put(file,",h="); put(file,nd.h,1); put(file,")");
end put;
procedure put ( lnd : in Link_to_Pieri_Node ) is
begin
put(Standard_Output,lnd);
end put;
procedure put ( file : in file_type; lnd : in Link_to_Pieri_Node ) is
begin
put(file,lnd.all);
if lnd.ancestor /= null
then put(file," > ");
put(file,lnd.ancestor);
end if;
end put;
procedure put ( t : in Pieri_Tree ) is
begin
put(Standard_Output,t);
end put;
procedure put ( t : in Pieri_Tree; level : in natural ) is
begin
put(Standard_Output,t,level);
end put;
procedure put ( file : in file_type;
t : in Pieri_Tree; level : in natural ) is
procedure Write_Node ( lnd : in Link_to_Pieri_Node;
continue : out boolean ) is
begin
put(file,lnd.all);
continue := true;
end Write_Node;
procedure Write_Nodes is new Enumerate_Nodes(Write_Node);
begin
Write_Nodes(t,level);
end put;
procedure put ( file : in file_type; t : in Pieri_Tree ) is
h : constant natural := Height(t);
begin
put(file,"Branching at "); put(file,t.branches); new_line(file);
put(file,"Root node : "); put(file,t.root.node); new_line(file);
for i in reverse 1..h loop
put(file,"Nodes at level "); put(file,i,1); put(file," :");
put(file,t,i); new_line(file);
end loop;
end put;
function Last_Child ( nd : Pieri_Node; i : natural ) return boolean is
-- DESCRIPTION :
-- Returns true if the ith child is the last child of the node.
begin
for j in (i+1)..nd.children'last loop
if nd.children(j) /= null
then return false;
end if;
end loop;
return true;
end Last_Child;
procedure Write_Labels ( file : in file_type;
nd : in Pieri_Node; jump : in natural;
last : in Boolean_Array ) is
-- DESCRIPTION :
-- Writes the contents of the Pieri node with the jump, taking into
-- account which children appeared last.
begin
if nd.h /= 0
then put(file," ");
end if;
for i in 1..(nd.h-1) loop
if last(i)
then put(file," ");
else put(file,"| ");
end if;
end loop;
if nd.h /= 0
then put(file,"!-+"); put(file,jump,1);
end if;
put(file,nd);
new_line(file);
end Write_Labels;
procedure Write_Nodes ( file : in file_type;
nd : in Pieri_Node; jump : in natural;
last : in out Boolean_Array ) is
-- DESCRIPTION :
-- Writes the contents of the Pieri node preceded with the index of
-- increase (jump), followed by the information on the children.
begin
Write_Labels(file,nd,jump,last);
for i in nd.children'range loop
if nd.children(i) /= null
then last(nd.h+1) := Last_Child(nd,i);
Write_Nodes(file,nd.children(i).all,i,last);
end if;
end loop;
end Write_Nodes;
procedure Write_Tree ( t : in Pieri_Tree ) is
begin
Write_Tree(Standard_Output,t);
end Write_Tree;
procedure Write_Tree ( file : in file_type; t : in Pieri_Tree ) is
last : Boolean_Array(1..Height(t));
begin
Write_Nodes(file,t.root.all,0,last);
end Write_Tree;
end Pieri_Trees_io;