Starting with:

 The target string: "METHINKS IT IS LIKE A WEASEL".
 An array of random characters chosen from the set of upper-case letters together with the space, and of the same length as the target string. (Call it the parent).
 A fitness function that computes the ‘closeness’ of its argument to the target string.
 A mutate function that given a string and a mutation rate returns a copy of the string, with some characters probably mutated.
 While the parent is not yet the target:
 copy the parent C times, each time allowing some random probability that another character might be substituted using mutate.
 Assess the fitness of the parent and all the copies to the target and make the most fit string the new parent, discarding the others.
 repeat until the parent converges, (hopefully), to the target.


See also

   Wikipedia entry:   Weasel algorithm.
   Wikipedia entry:   Evolutionary algorithm.

Note: to aid comparison, try and ensure the variables and functions mentioned in the task description appear in solutions



A cursory examination of a few of the solutions reveals that the instructions have not been followed rigorously in some solutions. Specifically,

 While the parent is not yet the target:
 copy the parent C times, each time allowing some random probability that another character might be substituted using mutate.
Note that some of the the solutions given retain characters in the mutated string that are correct in the target string. However, the instruction above does not state to retain any of the characters while performing the mutation. Although some may believe to do so is implied from the use of "converges"

(:* repeat until the parent converges, (hopefully), to the target.

Strictly speaking, the new parent should be selected from the new pool of mutations, and then the new parent used to generate the next set of mutations with parent characters getting retained only by not being mutated. It then becomes possible that the new set of mutations has no member that is fitter than the parent!

As illustration of this error, the code for 8th has the following remark.

Create a new string based on the TOS, changing randomly any characters which
don't already match the target:

NOTE: this has been changed, the 8th version is completely random now

Clearly, this algo will be applying the mutation function only to the parent characters that don't match to the target characters!

To ensure that the new parent is never less fit than the prior parent, both the parent and all of the latest mutations are subjected to the fitness test to select the next parent.




with Ada.Text_IO;
with Ada.Numerics.Discrete_Random;
with Ada.Numerics.Float_Random;
with Ada.Strings.Fixed;
with Ada.Strings.Maps;
 
procedure Evolution is
 
   -- only upper case characters allowed, and space, which uses '@' in
   -- internal representation (allowing subtype of Character).
   subtype DNA_Char is Character range '@' .. 'Z';
 
   -- DNA string is as long as target string.
   subtype DNA_String is String (1 .. 28);
 
   -- target string translated to DNA_Char string
   Target : constant DNA_String := "METHINKS@IT@IS@LIKE@A@WEASEL";
 
   -- calculate the 'closeness' to the target DNA.
   -- it returns a number >= 0 that describes how many chars are correct.
   -- can be improved much to make evolution better, but keep simple for
   -- this example.
   function Fitness (DNA : DNA_String) return Natural is
      Result : Natural := 0;
   begin
      for Position in DNA'Range loop
         if DNA (Position) = Target (Position) then
            Result := Result + 1;
         end if;
      end loop;
      return Result;
   end Fitness;
 
   -- output the DNA using the mapping
   procedure Output_DNA (DNA : DNA_String; Prefix : String := "") is
      use Ada.Strings.Maps;
      Output_Map : Character_Mapping;
   begin
      Output_Map := To_Mapping
        (From => To_Sequence (To_Set (('@'))),
         To   => To_Sequence (To_Set ((' '))));
      Ada.Text_IO.Put (Prefix);
      Ada.Text_IO.Put (Ada.Strings.Fixed.Translate (DNA, Output_Map));
      Ada.Text_IO.Put_Line (", fitness: " & Integer'Image (Fitness (DNA)));
   end Output_DNA;
 
   -- DNA_Char is a discrete type, use Ada RNG
   package Random_Char is new Ada.Numerics.Discrete_Random (DNA_Char);
   DNA_Generator : Random_Char.Generator;
 
   -- need generator for floating type, too
   Float_Generator : Ada.Numerics.Float_Random.Generator;
 
   -- returns a mutated copy of the parent, applying the given mutation rate
   function Mutate (Parent        : DNA_String;
                    Mutation_Rate : Float)
                    return          DNA_String
   is
      Result : DNA_String := Parent;
   begin
      for Position in Result'Range loop
         if Ada.Numerics.Float_Random.Random (Float_Generator) <= Mutation_Rate
         then
            Result (Position) := Random_Char.Random (DNA_Generator);
         end if;
      end loop;
      return Result;
   end Mutate;
 
   -- genetic algorithm to evolve the string
   -- could be made a function returning the final string
   procedure Evolve (Child_Count   : Positive := 100;
                     Mutation_Rate : Float    := 0.2)
   is
      type Child_Array is array (1 .. Child_Count) of DNA_String;
 
      -- determine the fittest of the candidates
      function Fittest (Candidates : Child_Array) return DNA_String is
         The_Fittest : DNA_String := Candidates (1);
      begin
         for Candidate in Candidates'Range loop
            if Fitness (Candidates (Candidate)) > Fitness (The_Fittest)
            then
               The_Fittest := Candidates (Candidate);
            end if;
         end loop;
         return The_Fittest;
      end Fittest;
 
      Parent, Next_Parent : DNA_String;
      Children            : Child_Array;
      Loop_Counter        : Positive := 1;
   begin
      -- initialize Parent
      for Position in Parent'Range loop
         Parent (Position) := Random_Char.Random (DNA_Generator);
      end loop;
      Output_DNA (Parent, "First: ");
      while Parent /= Target loop
         -- mutation loop
         for Child in Children'Range loop
            Children (Child) := Mutate (Parent, Mutation_Rate);
         end loop;
         Next_Parent := Fittest (Children);
         -- don't allow weaker children as the parent
         if Fitness (Next_Parent) > Fitness (Parent) then
            Parent := Next_Parent;
         end if;
         -- output every 20th generation
         if Loop_Counter mod 20 = 0 then
            Output_DNA (Parent, Integer'Image (Loop_Counter) & ": ");
         end if;
         Loop_Counter := Loop_Counter + 1;
      end loop;
      Output_DNA (Parent, "Final (" & Integer'Image (Loop_Counter) & "): ");
   end Evolve;
 
begin
   -- initialize the random number generators
   Random_Char.Reset (DNA_Generator);
   Ada.Numerics.Float_Random.Reset (Float_Generator);
   -- evolve!
   Evolve;
end Evolution;