II. Giải thuật di truyền với Bài toán tìm cực tiểu đa thức bậc n.
2. Code của chơng trình.
Option Explicit 'Bao loi khi gap mot bien khong khai bao Const pcro = 0.85
Const pmul = 0.05 'xac xuat dot bien thuong chon rat nho Const lenNST = 30
Dim a(100) As Double Dim hs As Integer
Dim n As Integer ' chua bac cua da thuc
Dim cantren, canduoi As Double ' Can tren, can duoi
Dim pi(50) As Double ' chua gia tri thich nghi cua cac ca the Dim vmin As Double 'Chua gia tri nho nhat
Dim f As Double 'gia tri cua da thuc Dim lmin(lenNST) As String
Dim QTmoi(100) As Cathe Dim QTcu(100) As Cathe
Dim NhapSua As Boolean 'Bien luan de ghi khi nhap hoac sua Dim vmax As Double ' Chua gia tri lon nhat
Dim lmax(lenNST) As String ' NST trung gian luu tru gia tri lon nhat '******************************' HAM KHOI TAO ************************* Private Sub KhoiTao()
Dim i, j As Integer Dim x1 As Double Dim s As Double Randomize
For i = 0 To popsize - 1
For j = 0 To (lenNST - 1) ' chua trong lenNST bit QTmoi(i).nst(j) = Str(Int(Rnd * 2)) Next Next 'giai ma For i = 0 To popsize - 1 s = 0 x1 = 0 For j = 0 To (lenNST - 1) s = s + Val(QTmoi(i).nst(j)) * 2 ^ ((lenNST - 1) - j)
Next
x1 = canduoi + (s * (cantren - canduoi) / (2 ^ lenNST - 1)) QTmoi(i).giatriphuhop = TinhGiaTriHamSo(x1)
Next End Sub
'************************tinh gia tri ham so************************** Private Function TinhGiaTriHamSo(x2 As Double) As Double Dim k As Double k = a(0) Dim l As Integer For l = 1 To n k = k + a(l) * x2 ^ l Next TinhGiaTriHamSo = k End Function '********************************************************************** 'HAM KHOI TAO GIA TRI NGAU NHIEN TRONG MIEN [0,1] Private Function NgauNhien01() As Double
Randomize
NgauNhien01 = (Rnd * 30000) / (30000) End Function
'HAM KHOI TAO GIA TRI NGAU NHIEN 0 HOAC 1Private Function NgauNhien10(p As Double) As Integer Private Function NgauNhien10(p As Double) As Integer Dim nn As Double
nn = NgauNhien01() If nn < p Then If nn < p Then
Else
NgauNhien10 = 1 End If
End Function
'************' HAM GAN GIA TRI CHO QUAN THE CU ****************Private Sub hamGiaTriPhuHop() Private Sub hamGiaTriPhuHop()
Dim i, j As Integer Dim s As Double Dim x2 As Double For j = 0 To popsize - 1 s = 0 For i = 0 To (lenNST - 1)
s = s + Val(QTcu(j).nst(i)) * 2 ^ ((lenNST - 1) - i) 'giai ma Next Next
x2 = canduoi + (s * (cantren - canduoi)) / ((2 ^ lenNST) - 1) QTcu(j).giatriphuhop = TinhGiaTriHamSo(x2)
Next End Sub
'************************ Ham chon loc ********************************* Private Function ChonLoc() As Double
Dim pa As Double Dim j As Integer
pa = NgauNhien01() 'Phat sinh mot so ngau nhien [0,1] j = -1
Do
j = j + 1
ChonLoc = j End Function
'*****************Ham sap xep tang- tim mim ******************
Private Sub SapXepTang() Dim i, j As Integer Dim tg As Cathe
For i = 0 To popsize - 2 For j = i + 1 To popsize - 1
If (QTcu(i).giatriphuhop > QTcu(j).giatriphuhop) Then tg = QTcu(i) QTcu(i) = QTcu(j) QTcu(j) = tg End If Next Next End Sub
**********************' Ham sap xep giam - Tim max****************
Private Sub SapXepGiam() Dim i, j As Integer
Dim tg As Cathe
For i = 0 To popsize - 2 For j = i + 1 To popsize - 1
If (QTcu(i).giatriphuhop < QTcu(j).giatriphuhop) Then tg = QTcu(i)
QTcu(i) = QTcu(j) QTcu(j) = tg
Next Next End Sub
'************** Ham tim gia tri nho nhat- Tim min************
Private Sub TimMin() Dim i As Integer Dim min As Double
min = QTcu(0).giatriphuhop If min <= vmin Then
For i = 0 To (lenNST - 1) lmin(i) = QTcu(0).nst(i) Next vmin = min End If End Sub
'************* Ham tim gia tri lon nhat - Tim max **************
Private Sub TimMax() Dim i As Integer Dim max As Double
max = QTcu(0).giatriphuhop If max >= vmax Then
For i = 0 To (lenNST - 1) lmax(i) = QTcu(0).nst(i) Next vmax = max End If End Sub
'***ham dot bien, ap dung qui tac dot bien tri nhi phan **** Private Function DotBien(s As String, p As Double) As String
Dim pa As Double pa = NgauNhien01() If (pa >= p) Then If (s <> 0) Then DotBien = 0 Else DotBien = 1 End If End If DotBien = s End Function
'*************************Lai ghep don diem*************************
Private Sub Laighep(cha1 As String, cha2 As String, con1 As String, con2 As String, pdb As Double, plg As Double)
Dim i, pop As Integer If NgauNhien10(plg) Then
pop = Int(Rnd * lenNST) ' lay mot so bat ky lam vi tri lai ghep For i = 0 To pop - 1
con1(i) = DotBien(cha1(i), pdb) con2(i) = DotBien(cha2(i), pdb) Next
For i = pop To (lenNST - 1)
con1(i) = DotBien(cha2(i), pdb) con2(i) = DotBien(cha1(i), pdb)
Else For i = 0 To (lenNST - 1) con1(i) = DotBien(cha1(i), pdb) con2(i) = DotBien(cha2(i), pdb) Next End If End Sub
'**********************ham nap lai quan the***********************
' Sau khi mot quan the moi ra doi, no duoc nap vao quan the hien tai Private Sub TaiTao()
Dim i As Integer
For i = 0 To popsize - 1 QTcu(i) = QTmoi(i) Next
End Sub
'*****************************Ham sinh san**********************
Private Sub SinhSan()
Dim i, j, chon1, chon2 As Integer Dim pop As Integer
j = 0 Do Do
chon1 = ChonLoc() 'thu duoc vi tri j1 chon2 = ChonLoc() ' thu duoc vi tri j2 If NgauNhien10(pcro) Then
Randomize
pop = Int(Rnd * lenNST) ' lay mot so bat ky lam vi tri lai ghep For i = 0 To pop - 1
QTmoi(j).nst(i) = DotBien(QTcu(chon1).nst(i), pmul) QTmoi(j + 1).nst(i) = DotBien(QTcu(chon2).nst(i), pmul) Next
For i = pop To (lenNST - 1)
QTmoi(j).nst(i) = DotBien(QTcu(chon2).nst(i), pmul) QTmoi(j + 1).nst(i) = DotBien(QTcu(chon1).nst(i), pmul) Next
Else
For i = 0 To (lenNST - 1)
QTmoi(j).nst(i) = DotBien(QTcu(chon1).nst(i), pmul) QTmoi(j + 1).nst(i) = DotBien(QTcu(chon2).nst(i), pmul) Next
End If j = j + 2
Loop While j <= popsize End Sub
'*****Ham nhap gia tri ban dau, tinh muc do thich nghi*****
Private Sub NhapGiaTriBanDau() Dim i, j As Integer
Dim tg As Double Dim s As Double Dim k As Byte Dim tam As Double If cantren < canduoi Then tg = canduoi
End If
vmin = 1E+36 vmax = 1E-36
For i = 0 To lenNST - 1
lmin(i) = Str(0) ' Khoi tao cac gia tri trong nst =0 Next
For i = 0 To lenNST - 2 lmax(i) = Str(0) Next
Ntot = popsize / 2 'Chon mot nua so luong quan the ban dau 'Khoi tao gia tri cho quan the cu
For i = 0 To popsize - 1
For j = 0 To (lenNST - 1) ' chua trong lenNST bit QTcu(i).nst(j) = Str(Int(Rnd * 2)) Next Next For i = 0 To popsize - 1 s = 0 For k = 0 To (lenNST - 1) s = s + Val(QTcu(i).nst(k)) * 2 ^ ((lenNST - 1) - k) Next
tam = canduoi + (s * (cantren - canduoi) / (2 ^ lenNST - 1)) QTcu(i).giatriphuhop = TinhGiaTriHamSo(tam)
Next
'*** Tinh tong thich nghi- tong gia tri phu hop cua Ntot ca the *** f = 0