How to resolve the algorithm Evolutionary algorithm step by step in the Fortran programming language

Published on 12 May 2024 09:40 PM

How to resolve the algorithm Evolutionary algorithm step by step in the Fortran programming language

Table of Contents

Problem Statement

Starting with:

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, 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" 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. 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.

Let's start with the solution:

Step by Step solution about How to resolve the algorithm Evolutionary algorithm step by step in the Fortran programming language

Source code in the fortran programming language

 !***************************************************************************************************
 	module evolve_routines
 !***************************************************************************************************
 	implicit none
 	
 	!the target string:
 	character(len=*),parameter :: targ = 'METHINKS IT IS LIKE A WEASEL'
 	
 	contains
 !***************************************************************************************************
 	
 !********************************************************************
 	pure elemental function fitness(member) result(n)
 !********************************************************************
 ! The fitness function.  The lower the value, the better the match.
 ! It is zero if they are identical.
 !********************************************************************
 	
 	implicit none
 	integer :: n
 	character(len=*),intent(in) :: member
 	
 	integer :: i
 	
 	n=0
 	do i=1,len(targ)
 		n = n + abs( ichar(targ(i:i)) - ichar(member(i:i))  )
 	end do
 	
 !********************************************************************
 	end function fitness
 !********************************************************************
 	
 !********************************************************************
 	pure elemental subroutine mutate(member,factor)
 !********************************************************************
 ! mutate a member of the population.
 !********************************************************************
 	
 	implicit none
 	character(len=*),intent(inout) :: member   !population member
 	real,intent(in) :: factor                  !mutation factor
 	
 	integer,parameter :: n_chars = 27	!number of characters in set
 	character(len=n_chars),parameter :: chars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ '
 	
 	real    :: rnd_val
 	integer :: i,j,n
 	
 	n = len(member)
 		
 	do i=1,n
 		rnd_val = rand()
 		if (rnd_val<=factor) then   !mutate this element			
 			rnd_val = rand()
 			j = int(rnd_val*n_chars)+1   !an integer between 1 and n_chars
 			member(i:i) = chars(j:j)
 		end if
 	end do
 	
 !********************************************************************
	end subroutine mutate
 !********************************************************************

 !***************************************************************************************************
 	end module evolve_routines
 !***************************************************************************************************
 
 !***************************************************************************************************
 	program evolve
 !***************************************************************************************************
 ! The main program
 !***************************************************************************************************
 	use evolve_routines
 	
 	implicit none
 	
 	!Tuning parameters:
 	integer,parameter :: seed = 12345             !random number generator seed
 	integer,parameter :: max_iter = 10000         !maximum number of iterations
 	integer,parameter :: population_size = 200    !size of the population
 	real,parameter    :: factor = 0.04            ![0,1] mutation factor
 	integer,parameter :: iprint = 5               !print every iprint iterations
 	
 	!local variables:
 	integer :: i,iter
 	integer,dimension(1) :: i_best
 	character(len=len(targ)),dimension(population_size) :: population
 	
 	!initialize random number generator:
 	call srand(seed)
 	
 	!create initial population:
 	! [the first element of the population will hold the best member]
 	population(1) = 'PACQXJB CQPWEYKSVDCIOUPKUOJY'  !initial guess
 	iter=0
 		
 	write(*,'(A10,A30,A10)') 'iter','best','fitness'
 	write(*,'(I10,A30,I10)') iter,population(1),fitness(population(1))
 		
 	do 
 	
 		iter = iter + 1 !iteration counter
 		
  		!write the iteration:
 		if (mod(iter,iprint)==0) write(*,'(I10,A30,I10)') iter,population(1),fitness(population(1))
		
 		!check exit conditions:
 		if ( iter>max_iter .or. fitness(population(1))==0 ) exit
 	
 		!copy best member and mutate:
 		population = population(1)	
 		do i=2,population_size
 			call mutate(population(i),factor)	
 		end do
 	
 		!select the new best population member:
 		! [the best has the lowest value]
 		i_best = minloc(fitness(population))
 		population(1) = population(i_best(1))
 		 	
 	end do
 	
 	!write the last iteration:
 	if (mod(iter,iprint)/=0) write(*,'(I10,A30,I10)') iter,population(1),fitness(population(1))
 	 	
 	if (iter>max_iter) then
 		write(*,*) 'No solution found.'
 	else
 		write(*,*) 'Solution found.'
 	end if
 	
 !***************************************************************************************************
 	end program evolve
 !***************************************************************************************************


      iter                          best   fitness
         0  PACQXJB CQPWEYKSVDCIOUPKUOJY       459
         5  PACDXJBRCQP EYKSVDK OAPKGOJY       278
        10  PAPDJJBOCQP EYCDKDK A PHGQJF       177
        15  PAUDJJBO FP FY VKBL A PEGQJF       100
        20  PEUDJMOO KP FY IKLD A YECQJF        57
        25  PEUHJMOT KU FS IKLD A YECQJL        35
        30  PEUHJMIT KU GS LKJD A YEAQFL        23
        35  MERHJMIT KT IS LHJD A YEASFL        15
        40  MERHJMKS IT IS LIJD A WEASFL         7
        45  MERHINKS IT IS LIJD A WEASFL         5
        50  MERHINKS IT IS LIJD A WEASEL         4
        55  MERHINKS IT IS LIKD A WEASEL         3
        60  MESHINKS IT IS LIKD A WEASEL         2
        65  MESHINKS IT IS LIKD A WEASEL         2
        70  MESHINKS IT IS LIKE A WEASEL         1
        75  METHINKS IT IS LIKE A WEASEL         0


  

You may also check:How to resolve the algorithm Rep-string step by step in the BQN programming language
You may also check:How to resolve the algorithm Sort stability step by step in the REXX programming language
You may also check:How to resolve the algorithm Loops/For step by step in the 8086 Assembly programming language
You may also check:How to resolve the algorithm Bitmap/Flood fill step by step in the Racket programming language
You may also check:How to resolve the algorithm Chowla numbers step by step in the V (Vlang) programming language