11.md

Day 11

Firstly, we need some standard packages to read the text file and a list to read a seat layout.

with Ada.Text_IO;
with Ada.Containers.Indefinite_Doubly_Linked_Lists;

I will keep information about seats into an 2-dimentional array of enumeration type.

type Seat_State is (Floor, Empty, Occupied);

type Seat_Array is
     array (Positive range <>, Positive range <>) of Seat_State;

Let's write a function to read the seat layout from a file.

function Read_Seat_Layout return Seat_Array;

function Read_Seat_Layout return Seat_Array is
   package String_Lists is
     new Ada.Containers.Indefinite_Doubly_Linked_Lists (String);
      
   function To_Seat (Char : Character) return Seat_State is
     (case Char is
        when '.' => Floor,
        when 'L' => Empty,
        when '#'    => Occupied,
        when others => raise Constraint_Error);
      
   List : String_Lists.List;
   Input : Ada.Text_IO.File_Type;
   Cursor : String_Lists.Cursor;
begin
   Ada.Text_IO.Open (Input, Ada.Text_IO.In_File, "/home/jovyan/md/11/input");
      
   while not Ada.Text_IO.End_Of_File (Input) loop
      List.Append (Ada.Text_IO.Get_Line (Input));
   end loop;
      
   Cursor := List.First;
      
   return Result : Seat_Array
     (1 .. List.First_Element'Length,
      1 .. Positive (List.Length))
   do
      for Y in Result'Range (2) loop
         declare
            Line : String := String_Lists.Element (Cursor);
         begin
            for X in Result'Range (1) loop
               Result (X, Y) := To_Seat (Line (X));
            end loop;
               
            String_Lists.Next (Cursor);
         end;
      end loop;
   end return;
end Read_Seat_Layout;

Now read the layout.

Layout : constant Seat_Array := Read_Seat_Layout;

Suppose we have a function that calculates state of a seat in the next round. Then we could sovle the task by running round after round until the layout stops changing.

generic
   with function Seat_Turn
        (Data : Seat_Array; X, Y : Positive) return Seat_State;
procedure Solve (Input : Seat_Array; Result : out Seat_Array);
--  Run rounds on Input layout until it stops changing
   
procedure Solve (Input : Seat_Array; Result : out Seat_Array) is
      
   procedure Round (Input : Seat_Array; Output : out Seat_Array) is
   begin
      for X in Input'Range loop
         for Y in Input'Range (2) loop
            Output (X, Y) := Seat_Turn (Input, X, Y);
         end loop;
      end loop;
   end Round;
      
begin
   Result := Input;

   loop
      declare
         Output : Seat_Array (Result'Range (1), Result'Range (2));
      begin
         Round (Result, Output);
         
         exit when Result = Output;
         
         Result := Output;
      end;
   end loop;
end Solve;

Before we write Seat_Turn for Part I, we need a helper

function Is_Occupied (Data : Seat_Array; X, Y : Natural) return Natural is
  (if X in Data'Range (1)
       and then Y in Data'Range (2)
       and then Data (X, Y) = Occupied
         then 1 else 0);

This function return 1 if Data (X, Y) is occupied or 0 otherwise. Now Seat_Turn is simple:

function Seat_Turn (S : Seat_Array; X, Y : Positive) return Seat_State;
--  Changing seat for new round (Part I)

function Seat_Turn
  (S : Seat_Array; X, Y : Positive) return Seat_State
is
   Adjacent : constant Natural := 
     Is_Occupied (S, X - 1, Y - 1)
     + Is_Occupied (S, X, Y - 1)
     + Is_Occupied (S, X + 1, Y - 1)
     + Is_Occupied (S, X - 1, Y)
     + Is_Occupied (S, X + 1, Y)
     + Is_Occupied (S, X - 1, Y + 1)
     + Is_Occupied (S, X, Y + 1)
     + Is_Occupied (S, X + 1, Y + 1);
begin
   case S (X, Y) is
      when Empty =>
         return (if Adjacent = 0 then Occupied else Empty);
      when Occupied =>
         return (if Adjacent >= 4 then Empty else Occupied);
      when Floor =>
         return Floor;
   end case;
end Seat_Turn;

Another function counts occupied seats:

function Count_Occupied (Seats : Seat_Array) return Natural;
--  Return number of occupied seats

function Count_Occupied (Seats : Seat_Array) return Natural is
   Total : Natural := 0;
begin
   for X of Seats loop
      if X = Occupied then
         Total := Total + 1;
      end if;
   end loop;

   return Total;
end Count_Occupied;

Now we can solve part I:

declare
   procedure Solve_Part_1 is new Solve (Seat_Turn);

   Result : Seat_Array (Layout'Range (1), Layout'Range (2));
begin
   Solve_Part_1 (Layout, Result);
   Ada.Text_IO.Put_Line (Count_Occupied (Result)'Image);
end;

 2093

The part II isn't much harder:

function Seat_Turn_2 (Data : Seat_Array; X, Y : Positive) return Seat_State;
--  Changing seat for new round (Part II)

function Seat_Turn_2 (Data : Seat_Array; X, Y : Positive) return Seat_State is
   function Count (DX, DY : Integer) return Natural is
      NX : Natural := X + DX;
      NY : Natural := Y + DY;
   begin
      while NX in Data'Range (1)
          and then NY in Data'Range (2)
        and then Data (NX, NY) = Floor
      loop
         NX := NX + DX;
         NY := NY + DY;
      end loop;

      return Is_Occupied (Data, NX, NY);
   end Count;
      
   Adjacent : Natural := 
     Count (-1, -1) + Count (0, -1) + Count (+1, -1)
     + Count (-1, 0) + Count (+1, 0)
     + Count (-1, +1) + Count (0, +1) + Count (+1, +1);
begin
   case Data (X, Y) is
      when Empty =>
         return (if Adjacent = 0 then Occupied else Empty);
      when Occupied =>
         return (if Adjacent >= 5 then Empty else Occupied);
      when Floor =>
         return Floor;
   end case;
end Seat_Turn_2;

The solution for Part II:

declare
   procedure Solve_Part_2 is new Solve (Seat_Turn_2);

   Result : Seat_Array (Layout'Range (1), Layout'Range (2));
begin
   Solve_Part_2 (Layout, Result);
   Ada.Text_IO.Put_Line (Count_Occupied (Result)'Image);
end;

 1862

---

Back to Table of Contents