Genetic algorithm program

1 / 41

# Genetic algorithm program - PowerPoint PPT Presentation

Genetic algorithm program. Speaker: Tzung Da Jiang Adviser : Dr. Ja -Hon Lin . ! 定義參數. MODULE fit_para USE para implicit none real*8,parameter :: \$PI=3.141592653589793238D0 ! 宣告 8byte 的浮點數。 \$PI 為圓周率 integer*4 :: hdum ! 宣告 4byte 的整數 hdum 作為計數器

I am the owner, or an agent authorized to act on behalf of the owner, of the copyrighted work described.

## PowerPoint Slideshow about 'Genetic algorithm program' - meagan

Download Policy: Content on the Website is provided to you AS IS for your information and personal use and may not be sold / licensed / shared on other websites without getting consent from its author.While downloading, if for some reason you are not able to download a presentation, the publisher may have deleted the file from their server.

- - - - - - - - - - - - - - - - - - - - - - - - - - E N D - - - - - - - - - - - - - - - - - - - - - - - - - -
Presentation Transcript

### Genetic algorithm program

Speaker: TzungDa Jiang

!定義參數

MODULE fit_para

USE para

implicit none

real*8,parameter :: \$PI=3.141592653589793238D0

!宣告8byte的浮點數。\$PI為圓周率

integer*4 :: hdum

!宣告4byte的整數hdum作為計數器

real*8,parameter,dimension(\$PHASE_LEN) :: \$W_PO=(/(hdum,hdum=1,\$PHASE_LEN)/),&

! \$W_PO=1,2,3,4,5,6,7…201

\$PCORR=\$PI*2/\$PHASE_LEN*INT(\$PHASE_LEN/2)*(INT(\$PHASE_LEN/2)+\$W_PO)

! 設定linear chirp

END MODULE fit_para

!定義參數

MODULE para

implicit none

integer*4,parameter :: \$CHROM_LEN=50,\$CHROM_NO=20

! 染色體基因數 染色體數目

integer*4,parameter :: \$pop_BIT=3,\$pop_MOD=10,\$PHASE_LEN=201

! 位元數 十進位 資料取樣數

integer*4,parameter:: \$TAKE_POINT(\$CHROM_LEN)=(/10,30,50,61,71,81:120,130,140,145,160,190/)

! 內插取樣位址

real*4,parameter ::

\$MUT_PROB=0.01,\$CROSS_PROB=0.5,\$SELEC_PROB=0.008

! 突變率 交配率 交換率

real*8,parameter :: \$Phase_range=3.5D0, \$value=1.0D-2

! 設最大相位邊界 終止程式條件(誤差標準)

END MODULE para

!設定輸入與輸出路徑

MODULE path1

implicit none

character*13,parameter :: path='D:\USER\kk\ga'

character*14,parameter :: path2='\finally\file\'

character*10,parameter:: in_1=‘one.dat’!輸入檔案 一倍頻訊號(雙精確)

character*10,parameter:: in_2=‘dc.dat’直流訊號(雙精確)

character*10,parameter:: in_3=‘two.dat‘ 二倍頻訊號(雙精確)

character*24,parameter:: err=‘error.txt’!輸出檔案 誤差率

character*16,parameter :: out_1=‘oring_one.txt’一倍頻訊號(Ascii)

character*17,parameter :: out_2=‘retri_tinten.txt‘ 重建強度(時域)

character*16,parameter :: out_3=‘tphase.txt’重建相位(時域)

character*16,parameter :: out_4='oring_dc.txt‘ 直流訊號(Ascii)

character*16,parameter :: out_5='oring_u.txt‘ 二倍頻訊號(Ascii)

character*16,parameter :: out_6=‘wphase.txt’重建相位(頻域)

END MODULE path1

encode

Nth generation

Selection

Crossover

Mutation

Fitness

Best result

End

!主程式(宣告變數)

Program main

USE para

Use fit_para

Use path1

implicit none

integer*4,dimension(\$CHROM_LEN,\$CHROM_NO,\$pop_BIT) :: pop

!宣告3位元,20條染色體,每一條染色體有50個基因的三維陣列

integer:: kk, times, I

real*8,dimension(\$PHASE_LEN) :: espe, ispe, uspe

!一倍頻 DC 二倍頻

real*8:: bestfit

!宣告最佳的染色體之適應度

integer*4,dimension(\$CHROM_LEN,1,\$pop_BIT) :: bestpop

!宣告最佳的染色體內部的基因及位元資料，大小為(50,1,3)

common bestfit, bestpop

!將以上兩著設為全域變數(主副程式皆適用)

!主程式(宣告函式)

interface

!宣告子涵式

function initial()!宣告產生初始染色體之副程式

USE para!使用前面定義之參數

implicit none

integer*4,dimension(\$CHROM_LEN,\$CHROM_NO,\$pop_BIT):: initial

end function initial

subroutine mutation(pop)!宣告突變副程式

USE para

implicit none

integer*4,dimension(:,:,:) :: pop

end subroutine mutation

subroutine crossover(pop)!宣告交配副程式

USE NUMERICAL_LIBRARIES

USE para

implicit none

integer*4,target,dimension(:,:,:) :: pop

end subroutine crossover

!主程式(宣告函式)

subroutine selection(pop,espe,ispe,uspe)!宣告篩選副程式

USE para

implicit none

integer*4,dimension(:,:,:) :: pop

real*8,dimension(:) :: espe,ispe,uspe

end subroutine selection

subroutine saveout(bestpop,espe,ispe,uspe)!宣告資料儲存副程式

USE NUMERICAL_LIBRARIES

Use para

USE fit_para

implicit none

integer*4,dimension(\$CHROM_LEN,1,\$pop_BIT) :: bestpop

real*8,dimension(:) :: espe,ispe,uspe

end subroutine saveout

end interface

!主程式(讀取輸入資料)

character*65 path_in1!定義路徑

character*65 path_in2

character*65 path_in3

character*65 path_err

path_in1=path//path2//in_1

path_in2=path//path2//in_2

path_in3=path//path2//in_3

path_err=path//path2//err

close(11)

close(12)

close(13)

!主程式(核心)

espe=espe/sum(espe)!將這三筆資料做正規化

uspe=uspe/sum(uspe)

ispe=ispe/sum(ispe)!執行到pause時，會暫停執行，直到

pause!使用者按下”Enter”鍵繼續執行

pop=initial()

bestfit=0D0!設最佳的染色體之適應度初值為0

open(UNIT=110,file=path_err)!打開檔案代碼為110，記錄誤差率至

do while(1D0/bestfit .GE. 1d-3) !設定誤差率,最佳誤差值為1/bestfit

call mutation(pop)!突變

call crossover(pop)!交配

call selection(pop,espe,ispe,uspe)!第一階段篩選

call crossover(pop) !再進行交配

call selection(pop,espe,ispe,uspe)!第二階段篩選

pop(:,\$CHROM_NO,:)=bestpop(:,1,:)

!保障一個名額給最佳染色體

call mutation(pop)!再進行突變

call selection(pop,espe,ispe,uspe)!第三階段篩選

pop(:,\$CHROM_NO,:)=bestpop(:,1,:)

!主程式(資料輸出)

write(*,'(A4,I7,A16,F20.9)') '第',times,'次最好的誤差值是',1D0/bestfit

write(110,*) 1D0/bestfit!將誤差值記錄誤差率至記事本

times=times+1

end do

close(110)!關閉記錄誤差值之記事本

call saveout(bestpop,espe,ispe,uspe)

!將重建出來的相位及強度寫進檔案內

end program main

2

4

6

j1(w)

j2(w)

j5(w)

j4(w)

j3(w)

!建立起始的三維陣列示意圖

NO 3

NO 2

NO 1

BIT

Chrom_len

!建立起始的三維陣列

function initial()

USE para

implicit none

integer*4,dimension(\$CHROM_LEN,\$CHROM_NO,\$pop_BIT) :: initial

!定義起始的函數

interface

function aaa(long)

implicit none

integer*4 ::long!所有基因長度

! long =CHROM_LEN*\$CHROM_NO*\$pop_BIT=50*20*3=3000

integer*4,dimension(long)::aaa

end function aaa!回傳aaa陣列

end interface

call RANDOM_SEED()!設亂數種子，取亂數使用

initial=reshape(aaa((\$CHROM_LEN*\$CHROM_NO*\$pop_BIT)),(/\$CHROM_LEN,\$CHROM_NO,\$pop_BIT/))

!建立一個三維陣列，其大小(50,20,3)

return

end function initial

!由亂數給定初值

function aaa(long)

USE para

implicit none

integer*4::long

integer*4,dimension(long) :: aaa

real*4,dimension(long) :: randa

integer :: dum

call RANDOM_NUMBER(randa)!取0~1之亂數給randa

randa=(real(\$pop_MOD,4))*randa;!將randa乘10，4為4byte

do dum=1,long,1

aaa(dum)=int(randa(dum),4) !取整數

end do

return

end function aaa

1

Error

6

2

Area

3

5

4

Selection

!篩選（宣告變數）

subroutine selection(pop,espe,ispe,uspe)

USE para

implicit none

integer*4,dimension(:,:,:) :: pop

real*8,dimension(:) :: espe,ispe,uspe

integer*4,parameter :: area=1000!圓盤面積大小

integer*4,dimension(area) :: selarea

integer:: dum,dun,dub

integer*4,dimension(\$CHROM_LEN,\$CHROM_NO,\$pop_BIT) :: gbuff

real*8,dimension(\$CHROM_NO) :: pfit!每條染色體之適應度

integer*4 :: bufa,bufb

real*4,dimension(\$CHROM_NO) :: r_sel

real*8:: bestfit!最佳染色體適應度

integer*4,dimension(\$CHROM_LEN,1,\$pop_BIT) :: bestpop

!最佳染色體期內部基因及位元資料

common bestfit,bestpop!對此兩者宣告全域變數

!篩選（決定適應度並分配圓盤面積）

interface

function calfit(pop,espe,ispe,uspe)!計算每條染色體之適應度

USE para

implicit none

integer*4,dimension(:,:,:) :: pop

real*8,dimension(:) :: espe,ispe,uspe

real*8,dimension(\$CHROM_NO) :: calfit

end function calfit!回傳calfit 之一維陣列

end interface

pfit=calfit(pop,espe,ispe,uspe)

if (bestfit < maxval(pfit)) then!當代染色體之最佳適應度是否比上一代好

bestfit=maxval(pfit)!刷新最佳染色體適應度

bestpop=pop(:,maxloc(pfit),:)!傳最佳染色體期內部基因及位元資料

end if

pfit=(DBLE(area)/sum(pfit))*pfit!分配圓盤面積

!篩選（分配位址並隨機挑選）

bufa=0

do dun=1,\$CHROM_NO,1!分配絕對位址

bufb=bufa+INT(pfit(dun),4)

selarea((bufa+1):bufb)=dun! Selarea紀錄某個區域是屬於哪條染色體

bufa=bufb

end do

if (bufa < area) selarea((bufa+1):area)=1!如果還有剩餘，就丟給第一條染色體

call Random_seed()

call RANDOM_NUMBER(r_sel)! 0<r_sel<1

do dun=1,\$CHROM_NO,1

bufb=selarea(INT((r_sel(dun)*area),4)+1)!0<1000*r_sel<1000射絕對位址

do dub=1,\$pop_BIT,1

do dum=1,\$CHROM_LEN,1

gbuff(dum,dun,dub)=pop(dum,bufb,dub)

end do!被挑選中的染色體資料就可保留至下一代

end do

end do

pop=gbuff

return

end subroutine selection

j(w)

j(w1)

j(w2)

j(w3)

j(w4)

j(w5)

!相位回朔示意圖

Frequency

E(w)

Error fun

E(t)

Itry(w)

utry(w)

FT

Etry(t)

Itry(t)

utry(t)

!計算適應度流程圖

IFT

Try phase

!計算適應度（宣告初始變數）

function calfit(pop,espe,ispe,uspe)

USE fit_para

implicit none

integer*4,dimension(:,:,:) :: pop!儲存基因資料之三維陣列

real*8,dimension(:) :: espe,ispe,uspe!分別為一倍頻,DC,二倍頻訊號

real*8 :: spene

real*8,dimension(\$CHROM_NO) :: calfit!記錄每條染色體之適應度

integer*4 :: sha(3),dum,dun,dub!三維陣列大小及迴圈計數

integer*4,allocatable,dimension(:,:) ::buffa!記錄基因之相位值

real*8,allocatable,dimension(:,:) :: buffb

real*8,dimension(\$PHASE_LEN) :: wphase,nispe,nuspe,espe_b

!分別代表重建後的相位值,強度,電場振幅

complex*16,dimension(\$PHASE_LEN) :: wfield,tfield,tinten,tufield,winten,wufield

real*8 :: wpoi(\$CHROM_LEN),err,temp(\$PHASE_LEN)

!wpoi=10,30,50,61,71,81:120,130,140,145,160,190

sha=shape(pop)!讀取三維陣列大小sha(1)=50 sha(2)=20 sha(3)=3

allocate(buffa(sha(1),sha(2)),buffb(sha(1),sha(2)))

!計算適應度（計算基因相位值）

buffa=0

do dub=1,sha(3),1

buffa=buffa+pop(:,:,dub)*(\$pop_MOD**(dub-1))!計算基因相位值

end do!238=2*100+3*10+8

buffb=DBLE(buffa)!轉為雙精確值

buffb=buffb*(\$PHASE_RANGE/DBLE(\$pop_MOD**(sha(3))))

!設最大相位3.5並將之分成1000刻度計算出實際相位

do dum=1,\$CHROM_LEN,1

wpoi(dum)=\$W_PO(\$TAKE_POINT(dum))

end do ! \$TAKE_POINT= 10,30,50,61,71,81:120,130,140,145,160,190

! \$W_PO=1,2,3,4,5,6,…,201

!wpoi=10,30,50,61,71,81:120,130,140,145,160,190

espe_b=DSQRT(espe)開根號

!計算適應度（執行內插並重建電場和強度）

do dun=1,sha(2),1

call dcsiez(\$CHROM_LEN,wpoi,buffb(:,dun),\$PHASE_LEN,\$W_PO,wphase)

!執行內插運算，buffb存放染色體50個基因相位值，wphase為內插之輸出

wfield=espe_b*DCMPLX(DCOS(wphase),DSIN(wphase))

!重新建立電場

call DFFTCB(\$PHASE_LEN,wfield,tfield)

!反傅立葉輸出

tfield=tfield*DCMPLX(DCOS(\$PCORR),-DSIN(\$PCORR))

!乘linear chirp

tinten=tfield*DCONJG(tfield)

tufield=tfield*tfield

call DFFTCF(\$PHASE_LEN,tinten,winten)

call DFFTCF(\$PHASE_LEN,tufield,wufield)

winten=winten/\$PHASE_LEN !做完傅立葉轉換後之處理

wufield=wufield/\$PHASE_LEN

winten=cshift(winten,-INT(\$PHASE_LEN/2))

wufield=cshift(wufield,-INT(\$PHASE_LEN/2))

!誤差值之計算

winten=winten*DCMPLX(DCOS(\$PCORR),DSIN(\$PCORR))

!乘linear chirp

wufield=wufield*DCMPLX(DCOS(\$PCORR),DSIN(\$PCORR))

nuspe=DREAL(wufield)*DREAL(wufield)+DIMAG(wufield)*DIMAG(wufield)

nuspe=nuspe/sum(nuspe)!正規化處理

nispe=(DREAL(winten)*DREAL(winten)+DIMAG(winten)*DIMAG(winten))

nispe=nispe/sum(nispe)

err=SUM((nispe-ispe)**2)/SUM((ispe)**2)+SUM((nuspe-uspe)**2)/SUM((uspe)**2)

!計算誤差值

calfit(dun)=(1D0)/err !適應度即為誤差值之倒數

enddo

deallocate(buffa,buffb)

return

end function calfit

Old

8

4

8

3

1

7

4

3

8

1

0

9

Temp

3

8

3

0

8

New

9

!突變示意圖

If <0.01

buff

0.003

0.3

0.002

0.007

0.43

0.02

!突變程式（宣告變數及函式）

subroutine mutation(pop)

USE para

implicit none

integer*4,dimension(:,:,:) :: pop!儲存基因資料之三維陣列

real*4,allocatable,dimension(:) :: buff

real*4:: duf

integer :: dum,dun,dub,coun,sha(3)

interface

function aaa(mle)

implicit none

integer*4 :: mle

integer*4,dimension(mle)::aaa

end function aaa!產生一組隨機數值給染色體

end interface

!突變程式（核心）

sha=shape(pop) !取三維陣列之長度

allocate(buff((sha(1)*sha(2)*sha(3))))! sha(1)=50,sha(2)=20,sha(3)=3

! allocate用來給buff陣列大小

call RANDOM_SEED()　　　　　　　 ！亂數種子

call RANDOM_NUMBER(buff)

coun=0

do dub=1,sha(3),1

do dun=1,sha(2),1

do dum=1,sha(1),1

coun=coun+1

if (buff(coun)<\$MUT_PROB) then　　！突變條件

call random_seed()

call RANDOM_NUMBER(duf)

pop(dum,dun,dub)=int((duf*real(\$pop_MOD,4)),4)

end if　　　　！符合突變條件，基因填入隨機整數

end do

end do

end do

deallocate(buff)

return

end subroutine mutation

3

1

5

7

8

4

0

1

4

6

2

3

4

2

3

5

6

1

0

1

4

7

8

3

!交配程式示意圖

If <0.008

0.002

Random

0.8

0.001

0.2

0.003

0.47

!交配程式（宣告變數）

subroutine crossover(pop)

USE NUMERICAL_LIBRARIES

USE para

implicit none

integer*4,target,dimension(:,:,:) :: pop

integer*4 :: tpp

integer :: sha(3),dum,dun,dub,plen

integer*4,pointer,dimension(:) :: pa,pb

real*4,allocatable,dimension(:) :: bufa,bufb

real*4,allocatable,dimension(:,:,:) :: bufc

integer*4,allocatable,dimension(:) :: bufi

sha=shape(pop)

plen=int((\$CROSS_PROB*real(sha(2),4)/2),4) ! \$CROSS_PROB=0.5 為交配機率

！取染色體對數０.5*20/2=5對

allocate(bufa(sha(2)),bufb(sha(2)),bufi(sha(2)),bufc(sha(1),plen,sha(3)))

!取陣列長度bufa,bufb,bufi為20之一為陣列:而bufc為(20,5,3)之三維陣列

call RANDOM_seed()

call RANDOM_NUMBER(bufa)

call RANDOM_seed()

call RANDOM_NUMBER(bufc)

!交配程式（核心）

do dum=1,sha(2),1

bufi(dum)=dum! bufi=1,2,3,4,5,6,…,20

end do

call SVRGP(sha(2),bufa,bufb,bufi) ! (in) bufa= 0.85 0.48 0.96 0.21 0.67 0.15

! (out)bufb=0.15 0.21 0.48 0.67 0.85 0.96

deallocate(bufa,bufb) ! (out)Bufi= 6 4 2 5 1 3

do dub=1,sha(3),1

do dun=1,plen,1

pa=>pop(:,bufi(2*dun-1),dub)!第一對 第二對 第三對

pb=>pop(:,bufi(2*dun),dub)!buff(1)buff(2) buff(3)buff(4) buff(5)buff(6)

do dum=1,sha(1),1

if (bufc(dum,dun,dub) < \$SELEC_PROB) then!基因對交換條件

tpp=pa(dum)! \$SELEC_PROB=0.008

pa(dum)=pb(dum)!進行交換

pb(dum)=tpp

end if

end do

end do

end do

deallocate(bufc,bufi)

return

end subroutine crossover

!檔案儲存（宣告變數）

SUBROUTINE saveout(bestpop,espe,ispe,uspe)

USE fit_para

Use path1

implicit none

integer*4 :: dum,dun,dub

integer*4,allocatable,dimension(:) :: buffa

real*8,allocatable,dimension(:) :: buffb

real*8,dimension(:) :: espe,ispe,uspe!分別為一倍頻,DC,二倍頻訊號

real*8,dimension(\$PHASE_LEN) :: wphase,nispe,nuspe,tphase

!分別代表重建後的相位值,強度,電場振幅

integer :: times

complex*16,dimension(\$PHASE_LEN) :: wfield,tfield,tinten,tufield,winten,wufield!場(頻域)(時域) 強度(時域)…

real*8 :: wpoi(\$CHROM_LEN),temp(\$PHASE_LEN),spene

integer*4,dimension(\$CHROM_LEN,1,\$pop_BIT):: bestpop

!最佳染色體內部基因及位元資料

!檔案儲存（宣告路徑及計算染色體相位）

character*65 path_out1

character*65 path_out2

character*65 path_out3

character*65 path_out4

character*65 path_out5

character*65 path_out6

path_out1=path//path2//out_1

path_out2=path//path2//out_2

path_out3=path//path2//out_3

path_out4=path//path2//out_4

path_out5=path//path2//out_5

path_out6=path//path2//out_6

allocate(buffa(\$CHROM_LEN),buffb(\$CHROM_LEN))

buffa=0

do dub=1,\$pop_BIT,1

buffa=buffa+bestpop(:,1,dub)*(\$pop_MOD**(dub-1))!計算基因相位值

end do!238=2*100+3*10+8

buffb=DBLE(buffa)!轉為雙精確值

buffb=buffb*(\$PHASE_RANGE/DBLE(\$pop_MOD**(\$pop_BIT)))

!設最大相位3.5並將之分成1000刻度計算出實際相位

!檔案儲存（計算電場及強度值）

do dum=1,\$CHROM_LEN,1

wpoi(dum)=\$W_PO(\$TAKE_POINT(dum))

end do! \$TAKE_POINT= 10,30,50,61,71,81:120,130,140,145,160,190

! \$W_PO=1,2,3,4,5,6,…,201

!wpoi=10,30,50,61,71,81:120,130,140,145,160,190

call dcsiez(\$CHROM_LEN,wpoi,buffb,\$PHASE_LEN,\$W_PO,wphase)

!執行內插運算

wfield=Dsqrt(espe)*DCMPLX(DCOS(wphase),DSIN(wphase))

!重新建立電場

call DFFTCB(\$PHASE_LEN,wfield,tfield)

!反傅立葉輸出

tfield=cshift(tfield,INT(-\$PHASE_LEN/2))

tfield=tfield*DCMPLX(DCOS(\$PCORR),-DSIN(\$PCORR))

!乘linear chirp

tinten=tfield*DCONJG(tfield)

tphase=DATAN2(DREAL(tfield),DIMAG(tfield))

!雙精確之actan(場(虛部)/ 場(實部))

!檔案儲存

open(UNIT=101,file=path_out1)

do times=1,\$PHASE_LEN,1

write(101,*) espe(times)!印出一倍頻訊號至檔案

end do

close(101)

open(UNIT=102,file=path_out4)

do times=1,\$PHASE_LEN,1

write(102,*) ispe(times)!印出直流訊號至檔案

end do

close(102)

open(UNIT=103,file=path_out5)

do times=1,\$PHASE_LEN,1

write(103,*) uspe(times)!印出二倍頻訊號至檔案

end do

close(103)

open(UNIT=102,file=path_out2)

do times=1,\$PHASE_LEN,1

write(102,*) REAL(tinten(times))!印出時域強度至檔案

end do

close(102)

!檔案儲存

open(UNIT=104,file=path_out3)

do times=1,\$PHASE_LEN,1

write(104,*) tphase(times)!印出時域相位至檔案

end do

close(104)

open(UNIT=105,file=path_out6)

do times=1,\$PHASE_LEN,1

write(105,*) wphase(times)!印出頻域相位至檔案

end do

close(105)

return

end SUBROUTINE saveout

Sech pulse autocorrelation

Y=Sech(1.76*(t/tp))

=0.15Pulse width=10fs

=802nm

Two photo absorbtion

One photo absorbtion