Evolutionary algorithm: Difference between revisions

{{works with|Fortran|2003}}

<lang fortran>

!***************************************************************************************************

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 = 100 !size of the population

real,parameter :: factor = 0.05 ![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

!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))

!write the iteration:

if (mod(iter,iprint)==0) write(*,'(I10,A30,I10)') iter,population(1),fitness(population(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

!***************************************************************************************************

</lang>

The output is:

<lang>

iter best fitness

0 PACQXJB CQPWEYKSVDCIOUPKUOJY 459

5 PATNXJBUCQP EYCSVDOIOUPLKOJO 316

10 PATNNJHU SP ELCSGPHIO PLDOJO 188

15 PATNNJHU NP EL LGPH O PEDOJO 93

20 PBTFNJHU NP GX LGJH C PEDOJL 65

25 PBTFIOHU HP GX LGJF C ZEDSIL 42

30 PFTHIOHU HS HX LGJF C WEDSIL 31

35 PFTHIOKU HS HU LGJE C WEDSDL 21

40 NFTHIOKS HS HU LGJE C WEDSDL 17

45 NETHIOKS HT HR LGJE C WEDSDL 14

50 NETHIOKS HT HR LGJE C WEDSDL 14

55 METHIOKS HT HR LGJE C WEASDL 10

60 METHIOKS HT HR LGJE B WEASDL 9

65 METHIOKS HT HR LGJE A WEASEL 7

70 METHIOKS IT HR LGKE A WEASEL 5

75 METHIOKS IT HR LGKE A WEASEL 5

80 METHINKS IT IS LGKE A WEASEL 2

85 METHINKS IT IS LHKE A WEASEL 1

90 METHINKS IT IS LHKE A WEASEL 1

95 METHINKS IT IS LHKE A WEASEL 1

100 METHINKS IT IS LIKE A WEASEL 0

101 METHINKS IT IS LIKE A WEASEL 0

</lang>