1 / 41

Genetic algorithm program

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 作為計數器

meagan
Télécharger la présentation

Genetic algorithm program

An Image/Link below is provided (as is) to download presentation 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. Content is provided to you AS IS for your information and personal use only. Download presentation by click this link. While downloading, if for some reason you are not able to download a presentation, the publisher may have deleted the file from their server. During download, if you can't get a presentation, the file might be deleted by the publisher.

E N D

Presentation Transcript

  1. Genetic algorithm program Speaker: TzungDa Jiang Adviser : Dr. Ja-Hon Lin

  2. !定義參數 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

  3. !定義參數 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

  4. !設定輸入與輸出路徑 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

  5. encode Nth generation Selection Crossover Mutation Fitness Best result End 主程式

  6. !主程式(宣告變數) 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 !將以上兩著設為全域變數(主副程式皆適用)

  7. !主程式(宣告函式) 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

  8. !主程式(宣告函式) 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

  9. !主程式(讀取輸入資料) 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 open(UNIT=11,FILE=path_in1,FORM=‘BINARY’,ACCESS=‘SEQUENTIAL’,ACTION=‘READ’)!開啟一倍頻訊號資料 read(11) (espe(kk),kk=1,$PHASE_LEN)!儲存至espe,大小為201筆資料 close(11) open(UNIT=12,FILE=path_in2,FORM=‘BINARY’,ACCESS=‘SEQUENTIAL’,ACTION=‘READ’)!開啟DC訊號資料 read(12) (ispe(kk),kk=1,$PHASE_LEN)!儲存至ispe ,大小為201筆資料 close(12) open(UNIT=13,FILE=path_in3,FORM=‘BINARY’,ACCESS=‘SEQUENTIAL’,ACTION=‘READ’) !開啟二倍頻訊號資料 read(13) (uspe(kk),kk=1,$PHASE_LEN) !儲存至uspe ,大小為201筆資料 close(13)

  10. !主程式(核心) 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,:)

  11. !主程式(資料輸出) 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

  12. 產生初值

  13. 2 4 6 j1(w) j2(w) j5(w) j4(w) j3(w) !建立起始的三維陣列示意圖 NO 3 NO 2 NO 1 BIT Chrom_len

  14. !建立起始的三維陣列 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

  15. !由亂數給定初值 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

  16. 1 Error 6 2 Area 3 5 4 Selection 篩選

  17. !篩選（宣告變數） 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!對此兩者宣告全域變數

  18. !篩選（決定適應度並分配圓盤面積） 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!分配圓盤面積

  19. !篩選（分配位址並隨機挑選） 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

  20. fITNESS

  21. j(w) j(w1) j(w2) j(w3) j(w4) j(w5) !相位回朔示意圖 Frequency

  22. E(w) Error fun E(t) Itry(w) utry(w) FT Etry(t) Itry(t) utry(t) !計算適應度流程圖 IFT Try phase

  23. !計算適應度（宣告初始變數） 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)))

  24. !計算適應度（計算基因相位值） 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)開根號

  25. !計算適應度（執行內插並重建電場和強度） 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))

  26. !誤差值之計算 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

  27. 突變

  28. 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

  29. !突變程式（宣告變數及函式） 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

  30. !突變程式（核心） 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

  31. 交配

  32. 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

  33. !交配程式（宣告變數） 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)

  34. !交配程式（核心） 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

  35. 檔案儲存

  36. !檔案儲存（宣告變數） 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 !最佳染色體內部基因及位元資料

  37. !檔案儲存（宣告路徑及計算染色體相位） 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刻度計算出實際相位

  38. !檔案儲存（計算電場及強度值） 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(場(虛部)/ 場(實部))

  39. !檔案儲存 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)

  40. !檔案儲存 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

  41. Sech pulse autocorrelation Y=Sech(1.76*(t/tp)) =0.15Pulse width=10fs =802nm Two photo absorbtion One photo absorbtion

More Related