-- Ada implementation of the Weasel program as described in
-- The Blind Watchmaker, by Richard Dawkins.
-- Matthew J Heaney, 2009/05/21
-- matthewjheaney@earthlink.net

with Ada.Text_IO;  use Ada.Text_IO;
with Ada.Integer_Text_IO;  use Ada.Integer_Text_IO;
with Ada.Numerics.Float_Random;
with Ada.Numerics.Discrete_Random; use Ada.Numerics;

procedure Weasel is

   subtype Letter_Index is Integer range 1 .. 27;
   type Letter_Array is array (Letter_Index) of Character;
   Letters : Letter_Array;

   subtype String_Subtype is String (1 .. 28);
   subtype Population_Index is Integer range 1 .. 100;
   type Population_Array is array (Population_Index) of String_Subtype;
   Population  : Population_Array;
   Best_Index  : Integer;
   Best_Score  : Natural;

   package Random_Letters is new Discrete_Random (Letter_Index);

   L : Random_Letters.Generator;
   use Random_Letters;

   M : Float_Random.Generator;
   use Float_Random;

   function Get_Score (S : String_Subtype) return Natural is
      T : constant String_Subtype := "METHINKS IT IS LIKE A WEASEL";
      Score : Natural := 0;

   begin
      for I in S'Range loop
         if S (I) /= T (I) then
            Score := Score + 1;
         end if;
      end loop;

      return Score;
   end Get_Score;

   procedure Find_Best_String is
      Score : Natural;
   begin
      Best_Index := 0;
      Best_Score := Natural'Last;

      for Index in Population'Range loop
         Score := Get_Score (Population (Index));

         if Score = 0 then
            Best_Score := 0;
            Best_Index := -Index;  -- signal caller that we're done

            return;
         end if;

         if Score < Best_Score then
            Best_Score := Score;
            Best_Index := Index;
         end if;
      end loop;

      pragma Assert (Best_Index /= 0);
   end Find_Best_String;

   procedure Mutate_Population is
      Best : constant String := Population (Best_Index);
   begin
      for I in Population'Range loop
         declare
            S : String renames Population (I);
         begin
            for J in S'Range loop
               if Random (M) <= 0.04 then
                  S (J) := Letters (Random (L));
               else
                  S (J) := Best (J);
               end if;
            end loop;
         end;
      end loop;
   end Mutate_Population;

begin -- Weasel

   Reset (L);
   Reset (M);

   -- initialize our alphabet

   Letters (1) := ' ';
   for I in 2 .. 27 loop
      Letters (I) := Character'Val (Character'Pos ('A') + I - 2);
   end loop;

   -- initialize our population

   for I in Population'Range loop
      for J in String_Subtype'Range loop
         Population (I)(J) := Letters (Random (L));
      end loop;
   end loop;

   for I in Positive loop
      Find_Best_String;

      Put (I, Width => 4);
      Put (' ');
      Put (Population (abs Best_Index));
      Put (" (");
      Put (Best_Score, Width => 0);
      Put (")");
      New_Line;

      exit when Best_Index <= 0;

      Mutate_Population;
   end loop;

end Weasel;