The Ada Program: josephus.adb

  1 -- josephus.adb:  remove every ith member of a circular list
  2 
  3 with Ada.Text_IO, Ada.Integer_Text_IO;
  4 use Ada;
  5 
  6 procedure Josephus is
  7 
  8    type String_Pointer is access String;
  9 
 10    type Soldier_Type is record
 11       Name  : String_Pointer;
 12       Alive : Boolean;
 13    end record;
 14 
 15    Max_Number_Of_Soldiers: constant := 100;
 16    Number_Of_Soldiers    : Integer range 0..Max_Number_Of_Soldiers := 0;
 17 
 18    -- start with 0 to facilitate modular arithmetic
 19    Soldiers: array (0..Max_Number_Of_Soldiers-1) of Soldier_Type;
 20 
 21    procedure Next (Index: in out Integer; Interval: Positive) is
 22    begin
 23       for I in 1..Interval loop
 24          loop
 25            Index := (Index + 1) mod Number_Of_Soldiers;
 26            exit when Soldiers(Index).Alive;
 27          end loop;
 28       end loop;
 29    end Next;
 30 
 31    Interval : Integer;
 32    Man      : Integer := Soldiers'First;
 33 
 34 begin
 35 
 36    -- get interval from the standard input
 37    Integer_Text_IO.Get (Interval);
 38    Text_IO.Skip_Line;
 39    Text_IO.Put ("Skip every ");
 40    Integer_Text_IO.Put (Interval, Width=>1);
 41    Text_IO.Put_Line (" soldiers.");
 42 
 43    -- get names (one per line) from the standard input
 44    declare
 45       Line: String (1..100);
 46       Length: Integer;
 47    begin
 48       while not (Text_IO.End_Of_File) loop
 49          Text_IO.Get_Line (Line, Length);
 50          Soldiers (Number_Of_Soldiers) := Soldier_Type'(
 51             Name=>new String'(Line(1..Length)), Alive=>True);
 52          Number_Of_Soldiers := Number_Of_Soldiers + 1;
 53       end loop;
 54    end;
 55 
 56    for I in 1..Number_Of_Soldiers-1 loop
 57       Soldiers(Man).Alive := False;
 58       Text_IO.Put (Soldiers(Man).Name.all);
 59       Text_IO.Put_Line (" commits suicide.");
 60       Next (Man, Interval);
 61    end loop;
 62 
 63    Text_IO.Put (Soldiers(Man).Name.all);
 64    Text_IO.Put_Line (" is the last.");
 65 
 66 end Josephus;