Re: Need some light on using Ada or not

[Shark8 <onewingedshark@gmail.com>]

On Feb 21, 4:52 am, Brian Drummond <brian_drumm...@btconnect.com>
wrote:
>
> As this is my first experiment with tasking, comments are welcome (and I'd be
> interested to see your version). If people think this is worth submitting to the
> shootout, I'll go ahead.
>
> - Brian

I used arrays for the most part, and then expanded it out to a
recursive-definition for the trees which would be too large for
the stack during creation.

It may be going against the spirit of the competition, but nothing
there said that we couldn't use arrays as binary-trees.


-- Package B_Tree
-- by Joey Fish

Package B_Tree is


   -- Contest rules state:
   --	define a tree node class and methods, a tree node record and
procedures,
   --	or an algebraic data type and functions.
   --
   -- B_Tree is the definition of such a record and procedures.

   Type Binary_Tree is Private;

   Function  Build_Tree	(Item : Integer; Depth : Natural)    Return
Binary_Tree;
   Function  Subtree	(Tree : Binary_Tree; Left : Boolean) Return
Binary_Tree;
   Function  Item_Check	(This : Binary_Tree)		     Return Integer;
   Procedure Free	(Tree : In Out Binary_Tree);

Private

   Type Node_Data;
   Type Data_Access		is Access Node_Data;
   SubType Not_Null_Data_Access	is Not Null Data_Access;

   Function Empty Return Not_Null_Data_Access;
   Type Binary_Tree( Extension : Boolean:= False ) is Record
      Data   :  Not_Null_Data_Access:= Empty;
   End Record;

End B_Tree;

--- B_Trees body
with
Ada.Text_IO,
--Ada.Numerics.Generic_Elementary_Functions,
Unchecked_Deallocation;

Package Body B_Tree is

   -- In some cases the allocataion of the array is too large, so we
can split
   -- that off into another tree, for that we have Tree_Array, which
is a
   -- Boolean-indexed array. {The Index is also shorthand for Is_left
on such.}
   Type Tree_Array	is Array (Boolean) of Binary_Tree;

   -- For trees of up to 2**17 items we store the nodes as a simple
array.
   Type Integer_Array	is Array (Positive Range <>) of Integer;
   Type Access_Integers	is Access Integer_Array;
   Type Node_Data(Extended : Boolean:= False) is Record
      Case Extended is
         When False => A : Not Null Access_Integers;
         When True  => B : Tree_Array;
      end Case;
   End Record;


   --  Returns the Empty List's Data.
   Function Empty Return Not_Null_Data_Access is
   begin
      Return New Node_Data'( A => New Integer_Array'(2..1 => 0),
Others => <> );
   end Empty;



      -- We'll need an integer-version of logrithm in base-2
      Function lg( X : In Positive ) Return Natural is
         --------------------------------------------
         --  Base-2 Log with a jump-table for the  --
         --  range 1..2**17-1 and a recursive call --
         --  for all values greater.		   --
         --------------------------------------------
      begin
         Case X Is
            When 2**00..2**01-1	=> Return  0;
            When 2**01..2**02-1	=> Return  1;
            When 2**02..2**03-1	=> Return  2;
            When 2**03..2**04-1	=> Return  3;
            When 2**04..2**05-1	=> Return  4;
            When 2**05..2**06-1	=> Return  5;
            When 2**06..2**07-1	=> Return  6;
            When 2**07..2**08-1	=> Return  7;
            When 2**08..2**09-1	=> Return  8;
            When 2**09..2**10-1	=> Return  9;
            When 2**10..2**11-1	=> Return 10;
            When 2**11..2**12-1	=> Return 11;
            When 2**12..2**13-1	=> Return 12;
            When 2**13..2**14-1	=> Return 13;
            When 2**14..2**15-1	=> Return 14;
            When 2**15..2**16-1	=> Return 15;
            When 2**16..2**17-1	=> Return 16;
            When Others		=> Return 16 + lg( X / 2**16 );
         End Case;
      end lg;

   Function Build_Tree (Item : Integer; Depth : Natural) Return
Binary_Tree is
      -- Now we need a function to allow the calculation of a node's
value
      -- given that node's index.
      Function Value( Index : Positive ) Return Integer is
	Level : Integer:= lg( Index );
	-- Note: That is the same as
	--	Integer( Float'Truncation( Log( Float(Index),2.0 ) ) );
	-- but without the Integer -> Float & Float -> Integer conversions.
      begin
         Return (-2**(1+Level)) + 1 + Index;
      end;

   Begin
      If Depth < 17 then
         Return Result : Binary_Tree do
            Result.Data:= New Node_Data'
		( A => New Integer_Array'(1..2**Depth-1 => <>), Others => <> );
            For Index in Result.Data.A.All'Range Loop
		Result.Data.All.A.All( Index ):= Value(Index) + Item;
            End Loop;
         End Return;
      else
         Return Result : Binary_Tree do
            Result.Data:= New Node_Data'
              ( B =>
                (True => Build_Tree(-1,Depth-1), False =>
Build_Tree(0,Depth-1)),
               Extended => True );
         End Return;

      end if;
   End Build_Tree;

   Function Subtree (Tree : Binary_Tree; Left : Boolean) Return
Binary_Tree is
   Begin
      if Tree.Data.Extended then
         -- If it is a large enough tree, then we already have it
split.
         Return Tree.Data.B(Left);
      else
         -- If not then we just need to calculate the middle and
return the
         -- proper half [excluding the first (root) node.
         Declare
            Data	  : Integer_Array Renames Tree.Data.All.A.All;
            Data_Length : Natural:= Data'Length;

            Mid_Point : Positive:= (Data_Length/2) + 1;
            SubType LeftTree is Positive Range
              Positive'Succ(1)..Mid_Point;
            SubType RightTree is Positive Range
              Positive'Succ(Mid_Point)..Data_Length;
         Begin
            Return Result : Binary_Tree Do
               if Left then
                  Result.Data:= New Node_Data'
                    ( A => New Integer_Array'( Data(LeftTree)  ),
Others => <> );
               else
                  Result.Data:= New Node_Data'
                    ( A => New Integer_Array'( Data(RightTree) ),
Others => <> );
               end if;
            End Return;
         End;
      end if;
   End Subtree;

   Function Check_Sum(	Data: In Integer_Array	) Return Integer is
      Depth : Natural:= lg(Data'Length);
      SubType Internal_Nodes is Positive Range 1..2**Depth-1;
   begin
      Return Result : Integer:= 0 do
         For Index in Internal_Nodes Loop
            Declare
               Left	: Positive:= 2*Index;
               Right	: Positive:= Left+1;
            Begin
               If Index mod 2 = 1 then
                  Result:= Result - Right + Left;
               else
                  Result:= Result + Right - Left;
               end if;
            End;
         End Loop;
      End Return;
   end Check_Sum;

   Function Item_Check	(This : Binary_Tree) Return Integer is
      -- For large trees this function calls itself recursively until
the
      -- smaller format is encountered; otherwise, for small trees, it
acts as
      -- a pass-througn to Check_Sum.
   Begin
      If This.Data.Extended then
         Declare

         Begin
            Return Result: Integer:= -1 do
               Result:=   Result
			+ Item_Check( This.Data.B(False) )
			- Item_Check( This.Data.B(True ) );
            End Return;
         End;
      else
         Declare
            Data : Integer_Array Renames This.Data.All.A.All;
         Begin
            Return Check_Sum( Data );
         End;
      end if;
   End Item_Check;

   Procedure Free	(Tree : In Out Binary_Tree) is
      procedure Deallocate is new
		Unchecked_Deallocation(Integer_Array, Access_Integers);
      procedure Deallocate is new
		Unchecked_Deallocation(Node_Data, Data_Access);

      Procedure Recursive_Free	(Tree : In Out Binary_Tree) is
      begin
         if Tree.Data.All.Extended then
            Recursive_Free( Tree.Data.B(True ) );
            Recursive_Free( Tree.Data.B(False) );
            Declare
               Data : Data_Access;
               For Data'Address Use Tree.Data'Address;
               Pragma Import( Ada, Data );
            Begin
               Deallocate(Data);
            End;
         else
            Declare
               Data : Data_Access;
               For Data'Address Use Tree.Data.All.A'Address;
               Pragma Import( Ada, Data );
            Begin
               Deallocate( Data );
               Data:= Empty;
            End;
         end if;
      end Recursive_Free;

   begin
      Recursive_Free( Tree );
      Tree.Data:= Empty;
   end Free;

Begin
   Null;
End B_Tree;

-- BinaryTrees.adb
-- by Jim Rogers
-- modified by Joey Fish

With
B_Tree,
Ada.Text_Io,
Ada.Real_Time,
Ada.Command_Line,
Ada.Characters.Latin_1,
;

Use
B_Tree,
Ada.Text_Io,
Ada.Command_Line,
Ada.Integer_Text_Io,
Ada.Characters.Latin_1
;

procedure BinaryTrees is
   --Depths
   Min_Depth	: Constant Positive := 4;
   Max_Depth	: Positive;
   Stretch_Depth: Positive;
   N		: Natural := 1;

   -- Trees
   Stretch_Tree,
   Long_Lived_Tree	: Binary_Tree;


   Check,
   Sum		: Integer;
   Depth	: Natural;
   Iterations	: Positive;

   Package Fn is New
Ada.Numerics.Generic_Elementary_Functions( Float );
   Function Value( Index : Positive ) Return Integer is
      Level : Integer:=
	Integer( Float'Truncation( Fn.Log( Float(Index),2.0 ) ) );
   begin
      Return (-2**(1+Level)) + 1 + Index;
   end;


begin
--     For Index in 1..2**3-1 loop
--        Put_Line( Value(Index)'img );
--     end loop;

--     Declare
--        -- allocate new memory:
--        Short_Lived_Tree_1: Binary_Tree:= Build_Tree(0, 20);
--     Begin
--        Sum:= Item_Check (Short_Lived_Tree_1);
--  --        Check := Check + Sum;
--  --        Free( Short_Lived_Tree_1 );
--        Put(Check'Img);
--     End;


   if Argument_Count > 0 then
      N := Positive'Value(Argument(1));
   end if;
   Max_Depth := Positive'Max(Min_Depth + 2, N);
   Stretch_Depth := Max_Depth + 1;
   Stretch_Tree := Build_Tree(0, Stretch_Depth);
   Check:= Item_Check(Stretch_Tree);
   Put("stretch tree of depth ");
   Put(Item => Stretch_Depth, Width => 1);
   Put(Ht & " check: ");
   Put(Item => Check, Width => 1);
   New_Line;

   Long_Lived_Tree := Build_Tree(0, Max_Depth);

   Depth := Min_Depth;
   while Depth <= Max_Depth loop
      Iterations := 2**(Max_Depth - Depth + Min_Depth);
      Check := 0;
      for I in 1..Iterations loop
         Declare
            Short_Lived_Tree_1: Binary_Tree:= Build_Tree(I, Depth);
         Begin
            Sum:= Item_Check (Short_Lived_Tree_1);
            Check := Check + Sum;
            Free( Short_Lived_Tree_1 );
         End;


         Declare
            Short_Lived_Tree_2: Binary_Tree:= Build_Tree(-I, Depth);
         Begin
            Sum:= Item_Check (Short_Lived_Tree_2);
            Check := Check + Sum;
            Free( Short_Lived_Tree_2 );
         End;
      end loop;

      Put(Item => Iterations * 2, Width => 0);
      Put(Ht & " trees of depth ");
      Put(Item => Depth, Width => 0);
      Put(Ht & " check: ");
      Put(Item => Check, Width => 0);
      New_Line;
      Depth := Depth + 2;
   end loop;
   Put("long lived tree of depth ");
   Put(Item => Max_Depth, Width => 0);
   Put(Ht & " check: ");
   check:= Item_Check(Long_Lived_Tree);
   Put(Item => Check, Width => 0);
   New_Line;

end BinaryTrees;