Drawing Bowling Pins (pyramid) with Recursion in Ada

Question

I know this is pushing the good will of the community by presenting my least elaborate work expecting someone to come and save me but I simply have no choice with nothing to lose. I've gone through packets, files, types, flags and boxes the last few weeks but I haven't covered much of recursion. Especially not drawing with recursion. My exam is in roughly one week and I hope this is ample time to repeat and learn simple recursion tricks like that of drawing bowling pins or other patterns:

I I I I I
 I I I I
  I I I
   I I
    I
n = 5

The problem I have with recursion is that I don't quite get it. How are you supposed to approach a problem like drawing pins like this using recursion?

The closest I've come is

I I I
I I
I
n = 3

and that's using

THIS CODE NOW WORKS

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;

procedure pyramidchaser is

   subtype X_Type is Integer range 0..30;
   X: X_Type;
   Indent : Integer := 0;

   procedure Numbergrabber (X : out Integer) is
   begin

      Put("Enter a number: ");
      Get(X);
      Skip_Line;
   end Numbergrabber;


   procedure PrintSpaces(I : in Integer) is
   begin 
      if I in X_Type then
      Put(" ");
      else
     return;
      end if;

      PrintSpaces(I - 1);
   end Printspaces;




   procedure PrintPins(i, n: in Integer) is
   begin
      if i >= n then 
     return;
      end if;

    Put('I');
    Put(' '); 

    PrintPins(i + 1, n);
    end Printpins;




   function Pins (X, Indent: in Integer) return Integer is

      Printed : Integer;

   begin

      Printed:= 0;
      if X > 0 then
     PrintSpaces(Indent);
     PrintPins(0, X);
     New_Line; 

     Printed := X + Pins(X - 1, Indent + 1);
      end if;
      return Printed;

   end Pins;

   Bowlingpins : Integer;

begin

   Numbergrabber(X);
   Bowlingpins:= Pins(X, Indent);

end pyramidchaser;

but with that I throw in a sum I dont really need just to kick off the recursive part which I dont really know why I do except it seems to be needed to be there. I experimented with code from a completely different assignment, thats why it looks the way it does. I know mod 2 will grant me too many new lines but at least it was an approach to finding heights to the pyramid. I understand the real approach is something similar to N+1 as with each step of the growing pyramid a new line is needed, but I dont know how to implement it.

I don't expect anyone to present a complete code but I hope somebody can clue me in on how to think on the way towards finding a solution.

I can still pass the exam without knowing recursion as its typically 2 assignments where one is and one isnt recursion and you need to pass one or the other, but given that I have some time I thought Id give it a chance.

As always, immensely thankful for anyone fighting the good fight!

Seeing this post gathered some attention Id like to expand the pyramid to one a little more complex:

THE PYRAMID PROBLEM 2

hope someone looks at it. I didnt expect so many good answers, I thought why not throw all I have out there.

Level 1
|=|

Level 2
|===|
||=||
|===|

Level 3

|=====|
||===||
|||=|||
||===||
|=====|

it needs to be figured out recursively. so some way it has to build both upwards and downwards from the center. 

To clarify Im studying for an exam and surely so are many others whom would be thankful for code to sink their teeth in. Maybe theres an easy way to apply what Tama built in terms of bowling pin lines in pyramid walls?

Answer 1

Bowling pins:

Printing ----I---- is just: (I'm going to use dashes instead of spaces throughout for readability)

Put_Line (4 * "-" & "I" & 4 * "-");

And printing the whole bowling triangle could be:

with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Text_IO;       use Ada.Text_IO;

procedure Main is
   procedure Print_Bowling_Line (Dashes : Natural; Pins : Positive) is
      Middle : constant String := (if Pins = 1 then "I"
                                   else (Pins - 1) * "I-" & "I");
   begin
      Put_Line (Dashes * "-" & Middle & Dashes * "-");
   end Print_Bowling_Line;
begin
   Print_Bowling_Line (0, 5);
   Print_Bowling_Line (1, 4);
   Print_Bowling_Line (2, 3);
   Print_Bowling_Line (3, 2);
   Print_Bowling_Line (4, 1);
end Main;

Writing the five repeated lines as a loop is quite obvious. For recursion, there are two ways.

Tail recursion

Tail recursion is the more natural 'ask questions, then shoot' approach; first check the parameter for an end-condition, if not, do some things and finally call self.

procedure Tail_Recurse (Pins : Natural) is
begin
   if Pins = 0 then
      return;
   end if;
   Print_Bowling_Line (Total_Pins - Pins, Pins);
   Tail_Recurse (Pins - 1);
end Tail_Recurse;

Head recursion

Head recursion is what mathematicians love; how do you construct a proof for N? Well, assuming you already have a proof for N-1, you just apply X and you're done. Again, we need to check the end condition before we go looking for a proof for N-1, otherwise we would endlessly recurse and get a stack overflow.

procedure Head_Recurse (Pins : Natural) is
begin
   if Pins < Total_Pins then
      Head_Recurse (Pins + 1); -- assuming N + 1 proof here
   end if;
   Print_Bowling_Line (Total_Pins - Pins, Pins);
end Head_Recurse;

For the full code, expand the following snippet:

with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Text_IO;       use Ada.Text_IO;

procedure Main is
   Total_Pins : Natural := 5;

   procedure Print_Bowling_Line (Dashes : Natural; Pins : Positive) is
      Middle : constant String := (if Pins = 1 then "I"
                                   else (Pins - 1) * "I-" & "I");
   begin
      Put_Line (Dashes * "-" & Middle & Dashes * "-");
   end Print_Bowling_Line;

   procedure Tail_Recurse (Pins : Natural) is
   begin
      if Pins = 0 then
         return;
      end if;
      Print_Bowling_Line (Total_Pins - Pins, Pins);
      Tail_Recurse (Pins - 1);
   end Tail_Recurse;

   procedure Head_Recurse (Pins : Natural) is
   begin
      if Pins < Total_Pins then
         Head_Recurse (Pins + 1); -- assuming N + 1 proof here
      end if;
      Print_Bowling_Line (Total_Pins - Pins, Pins);
   end Head_Recurse;
begin
   Total_Pins := 8;
   Head_Recurse (1);
end Main;

For simplicity, I don't pass around the second number, that indicates the stopping condition, but rather set it once before running the whole.

I always find it unfortunate to try to learn a technique by applying it where it makes the code more complicated, rather than less. So I want to show you a problem where recursion really does shine. Write a program that prints a maze with exactly one path between every two points in the maze, using the following depth-first-search pseudo code:

start by 'visiting' any field (2,2 in this example)
(recursion starts with this:)
while there are any neighbours that are unvisited,
   pick one at random and 
   connect the current field to that field and 
   run this procedure for the new field

As you can see in the animation below, this should meander randomly until it gets 'stuck' in the bottom left, after which it backtracks to a node that still has an unvisited neighbour. Finally, when everything is filled, all the function calls that are still active will return because for each node there will be no neighbours left to connect to.

You can use the skeleton code in the snippet below. The answer should only modify the Depth_First_Make_Maze procedure. It need be no longer than 15 lines, calling Get_Unvisited_Neighbours, Is_Empty on the result, Get_Random_Neighbour and Connect (and itself, of course).

with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Text_IO;       use Ada.Text_IO;
with Ada.Containers;                     use Ada.Containers;
with Ada.Containers.Vectors;
with Ada.Numerics.Discrete_Random;

procedure Main is
   N : Positive := 11; -- should be X*2 + 1 for some X >= 1

   type Cell_Status is (Filled, Empty);
   Maze : array (1 .. N, 1 .. N) of Cell_Status := (others => (others => Filled));

   procedure Print_Maze is
   begin
  for Y in 1 .. N loop
     for X in 1 .. N loop
        declare
           C : String := (case Maze (X, Y) is
                             --when Filled => "X", -- for legibility,
                             when Filled => "█", -- unicode block 0x2588 for fun
                             when Empty  => " ");
        begin
           Put (C);
        end;
     end loop;
     Put_Line ("");
  end loop;
   end Print_Maze;

   type Cell_Address is record
  X : Positive;
  Y : Positive;
   end record;

   procedure Empty (Address : Cell_Address) is
   begin
  Maze (Address.X, Address.Y) := Empty;
   end Empty;

   procedure Connect (Address1 : Cell_Address; Address2 : Cell_Address) is
  Middle_X : Positive := (Address1.X + Address2.X) / 2;
  Middle_Y : Positive := (Address1.Y + Address2.Y) / 2;
   begin
  Empty (Address1);
  Empty (Address2);
  Empty ((Middle_X, Middle_Y));
   end Connect;

   function Cell_At (Address : Cell_Address) return Cell_Status is (Maze (Address.X, Address.Y));
   function Left (Address : Cell_Address) return Cell_Address is (Address.X - 2, Address.Y);
   function Right (Address : Cell_Address) return Cell_Address is (Address.X + 2, Address.Y);
   function Up (Address : Cell_Address) return Cell_Address is (Address.X, Address.Y - 2);
   function Down (Address : Cell_Address) return Cell_Address is (Address.X, Address.Y + 2);

   type Neighbour_Count is new Integer range 0 .. 4;
   package Neighbours_Package is new Ada.Containers.Vectors (Index_Type => Natural, Element_Type => Cell_Address);
   use Neighbours_Package;

   function Get_Unvisited_Neighbours (Address : Cell_Address) return Neighbours_Package.Vector is
  NeighbourList : Neighbours_Package.Vector;
   begin
  NeighbourList.Reserve_Capacity (4);
  if Address.X >= 4 then
     declare
        L : Cell_Address := Left (Address);
     begin
        if Cell_At (L) = Filled then
           NeighbourList.Append (L);
        end if;
     end;
  end if;
  if Address.Y >= 4 then
     declare
        U : Cell_Address := Up (Address);
     begin
        if Cell_At (U) = Filled then
           NeighbourList.Append (U);
        end if;
     end;
  end if;
  if Address.X <= (N - 3) then
     declare
        R : Cell_Address := Right (Address);
     begin
        if Cell_At (R) = Filled then
           NeighbourList.Append (R);
        end if;
     end;
  end if;
  if Address.Y <= (N - 3) then
     declare
        D : Cell_Address := Down (Address);
     begin
        if Cell_At (D) = Filled then
           NeighbourList.Append (D);
        end if;
     end;
  end if;
  return NeighbourList;
   end Get_Unvisited_Neighbours;

   package Rnd is new Ada.Numerics.Discrete_Random (Natural);
   Gen : Rnd.Generator;

   function Get_Random_Neighbour (List : Neighbours_Package.Vector) return Cell_Address is
  Random : Natural := Rnd.Random (Gen);
   begin
  if Is_Empty (List) then
     raise Program_Error with "Cannot select any item from an empty list";
  end if;
  declare
     Index : Natural := Random mod Natural (List.Length);
  begin
     return List (Index);
  end;
   end Get_Random_Neighbour;

   procedure Depth_First_Make_Maze (Address : Cell_Address) is
   begin
  null;
   end Depth_First_Make_Maze;
begin
   Rnd.Reset (Gen);
   Maze (1, 2) := Empty; -- entrance
   Maze (N, N - 1) := Empty; -- exit
   Depth_First_Make_Maze ((2, 2));
   Print_Maze;
end Main;

To see the answer, expand the following snippet.

procedure Depth_First_Make_Maze (Address : Cell_Address) is
begin
   loop
  declare
     Neighbours : Neighbours_Package.Vector := Get_Unvisited_Neighbours (Address);
  begin
     exit when Is_Empty (Neighbours);
     declare
        Next_Node : Cell_Address := Get_Random_Neighbour (Neighbours);
     begin
        Connect (Address, Next_Node);
        Depth_First_Make_Maze (Next_Node);
     end;
  end;
   end loop;
end Depth_First_Make_Maze;

Converting recursion to loop

Consider how a function call works; we take the actual parameters and put them on the call stack along with the function's address. When the function completes, we take those values off the stack again and put back the return value.

We can convert a recursive function by replacing the implicit callstack containing the parameters with an explicit stack. I.e. instead of:

procedure Foo (I : Integer) is
begin
   Foo (I + 1);
end Foo;

We would put I onto the stack, and as long as there are values on the stack, peek at the top value and do the body of the Foo procedure using that value. When there is a call to Foo within that body, push the value you would call the procedure with instead, and restart the loop so that we immediately start processing the new value. If there is no call to self in this case, we discard the top value on the stack.

Restructuring a recursive procedure in this way will give you an insight into how it works, especially since pushing on to the stack is now separated from 'calling' that function since you explicitly take an item from the stack and do something with it.

You will need a stack implementation, here is one that is suitable:

Bounded_Stack.ads

generic
   max_stack_size : Natural;
   type Element_Type is private;
package Bounded_Stack is
   type Stack is private;
   function Create return Stack;
   procedure Push (Onto : in out Stack; Item : Element_Type);
   function Pop (From : in out Stack) return Element_Type;
   function Top (From : in out Stack) return Element_Type;
   procedure Discard (From : in out Stack);
   function Is_Empty (S : in Stack) return Boolean;
   Stack_Empty_Error : exception;
   Stack_Full_Error : exception;
private
   type Element_List is array (1 .. max_stack_size) of Element_Type;
   type Stack is
      record
         list : Element_List;
         top_index : Natural := 0;
      end record;
end Bounded_Stack;

Bounded_Stack.adb

package body Bounded_Stack is

   function Create return Stack is
   begin
      return (top_index => 0, list => <>);
   end Create;

   procedure Push (Onto : in out Stack; Item : Element_Type) is
   begin
      if Onto.top_index = max_stack_size then
         raise Stack_Full_Error;
      end if;
      Onto.top_index := Onto.top_index + 1;
      Onto.list (Onto.top_index) := Item;
   end Push;

   function Pop (From : in out Stack) return Element_Type is
      Top_Value : Element_Type := Top (From);
   begin
      From.top_index := From.top_index - 1;
      return Top_Value;
   end Pop;

   function Top (From : in out Stack) return Element_Type is
   begin
      if From.top_index = 0 then
         raise Stack_Empty_Error;
      end if;
      return From.list (From.top_index);
   end Top;

   procedure Discard (From : in out Stack) is
   begin
      if From.top_index = 0 then
         raise Stack_Empty_Error;
      end if;
      From.top_index := From.top_index - 1;
   end Discard;

   function Is_Empty (S : in Stack) return Boolean is (S.top_index = 0);
end Bounded_Stack;

It can be instantiated with a maximum stack size of Width*Height, since the worst case scenario is when you happen to choose a non-forking path that visits each cell once:

N_As_Cell_Size : Natural := (N - 1) / 2;
package Cell_Stack is new Bounded_Stack(max_stack_size => N_As_Cell_Size * N_As_Cell_Size, Element_Type => Cell_Address);

Take your answer to the previous assignment, and rewrite it without recursion, using the stack above instead.

To see the answer, expand the following snippet.

procedure Depth_First_Make_Maze (Address : Cell_Address) is
   Stack : Cell_Stack.Stack := Cell_Stack.Create;
   use Cell_Stack;
begin
   Push (Stack, Address);
   loop
  exit when Is_Empty (Stack);
  declare
     -- this shadows the parameter, which we shouldn't refer to directly anyway
     Address : Cell_Address := Top (Stack);
     Neighbours : Neighbours_Package.Vector := Get_Unvisited_Neighbours (Address);
  begin
     if Is_Empty (Neighbours) then
        Discard (Stack); -- equivalent to returning from the function in the recursive version
     else
        declare
           Next_Cell : Cell_Address := Get_Random_Neighbour (Neighbours);
        begin
           Connect (Address, Next_Cell);
           Push (Stack, Next_Cell); -- equivalent to calling self in the recursive version
        end;
     end if;
  end;
   end loop;
end Depth_First_Make_Maze;