案例之遗传算法的Fortran实现

缘由

把这一部分的内容放在了MATLAB分栏下， 因为Fortran相关的工作现在我进行的不多，而且脱开Fortran的外衣也很容易移植到MATLAB里，作为一个算法的记录吧

过程

源代码

遗传算法的 fortran 实现，源代码如下
function shiying(ranseti) !评价适应值的子函数 real::ranseti(4),shiying,sum
integer::i
sum=1
do i=1,4 sum=sum+ranseti(i)**2 enddo shiying=1.0/sum endfunction
function best(elva) !判断最佳的染色体
real::elva(5)!elva 是一个一维数组，存储着五个染色体的适应度 integer::i,j,best !best 存储的是最好染色体的下标
do i=1,5
do j=1,5 if(elva(i)<elva(j))goto 10 best=i
enddo
10 continue enddo endfunction

subroutine xuanze(elva,chose) !用轮盘赌选择选择参加交配的染色体 real::sum,elva(5),p(5),random(5),psum
integer::i,j,chose(5)
sum=0
p=0
do i=1,5
sum=sum+elva(i)
enddo
do i=1,5
p(i)=elva(i)/sum
enddo
do i=1,5
call random_number(random(i)) enddo
do i=1,5
psum=0 do j=1,5
psum=psum+p(j) if(random(i)<=psum)then chose(i)=j
exit
endif
enddo enddo
endsubroutine
subroutine jiaopeide© !交配过程 real::random(5),c(5,4),temp(5,4),jiaopeijiedian(5) real,allocatable::jiaopei(:,: ) !不知道后面的可不可以写常数 integer::i,key(5),m,number(5)
key=0
do i=1,5
call random_number(random(i)) enddo
m=0
do i=1,5
if(random(i)<=0.88)then key(i)=1
m=m+1
endif
enddo allocate(jiaopei(m,4)) j=0
do i=1,5

if(key(i)==1)then j=j+1 number(j)=i jiaopei(j,:)=c(i,:) endif
enddo
do i=1,m/2
call random_number(jiaopeijiedian(i))
jiaopeijiedian(i)=floor(jiaopeijiedian(i)*3)
enddo
jiaopeijiedian=jiaopeijiedian+1
do i=1,m,2
jiaopei(i,jiaopeijiedian(i):)=temp(i,jiaopeijiedian(i): ) jiaopei(i,jiaopeijiedian(i):)=jiaopei(i+1,jiaopeijiedian(i): ) jiaopei(i+1,jiaopeijiedian(i):)=temp(i,jiaopeijiedian(i): )
enddo
do j=1,m c(number(j),:)=jiaopei(j,:)!至此完成交配过程，未参与交配的算子直接复制到下一代中 enddo
endsubroutine !此时二维数组 c 的每一行为一个子代染色体
subroutine bianyi© !少量的变异 real::c(5,4),random(5,4) integer::i,j
do i=1,5
do j=1,4
call random_number(random(i,j)) if(random(i,j)<=0.1)then
call random_number(random(i,j)) c(i,j)=random(i,j)
endif
enddo enddo
endsubroutine
subroutine chushihua© !初始化种群染色体 real::c(5,4),random(5,4)
integer::i,j
do i=1,5
do j=1,4
call random_number(random(i,j)) c(i,j)=random(i,j)
enddo
enddo

endsubroutine !群体初始化结束
program yichuansuanfa
implicit none real::ranseti(5,4),shiyingzhi(5),shiying,jiaopei(5,4) integer::best,i,j,bestt,choice(5)
call chushihua(ranseti)
print*,ranseti
print*
do
do i=1,5
shiyingzhi(i)=shiying(ranseti(i,:))
enddo
bestt=best(shiyingzhi)
print*,ranseti
print*
if(1.0-shiyingzhi(bestt)<0.1)exit !说实话，这个判断条件是我在已知最优值是一的情况下写
出的，如果不知道最优值，要繁殖进化到什条件后退出呢? call xuanze(shiyingzhi,choice)
do i=1,5
jiaopei(i,:)=ranseti(choice(i),: )
enddo
call jiaopeide(jiaopei) ranseti=jiaopei
call bianyi(ranseti)
!do i=1,5 !shiyingzhi(i)=shiying(ranseti(i,:)) !enddo
!bestt=best(shiyingzhi)
enddo
print*,ranseti
print* print*,ranseti(bestt,:) print* print*,shiyingzhi(bestt) end