遗传算法.frm

应用改进自适应遗传算法结合最小二乘法求解优化参数

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   6855
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   10260
   LinkTopic       =   "Form1"
   ScaleHeight     =   6855
   ScaleWidth      =   10260
   StartUpPosition =   3  '窗口缺省
   Begin VB.PictureBox Picture1 
      Height          =   4935
      Left            =   4080
      ScaleHeight     =   4875
      ScaleWidth      =   5715
      TabIndex        =   0
      Top             =   600
      Width           =   5775
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Click()
   sel_bz = 1 '1:递减曲线,2:Weng旋回
   formbl_x = 1: formbl_y = 1
   Dim qi(), n(), di(), funsy(), qi_mid(), n_mid(), di_mid(), BZ(), cont(), cont_mid()
   Dim tao() As Double 'dim 时滞系数
   Dim lamd() As Double
   Dim tao_mid() As Double
   Dim lamd_mid() As Double
   Dim choose1()
   popnum = 20: pc = 0.95: arel = 0.1: pm = 0.008: pfnum = 10
   ReDim qi(popnum), n(popnum), di(popnum), funsy(popnum), cont(popnum)
   ReDim tao(popnum, 11) As Double 'dim 时滞系数
   ReDim lamd(popnum, 11) As Double
   ReDim tao_mid(1000, 11) As Double 'dim 时滞系数
   ReDim lamd_mid(popnum, 11) As Double
   ReDim qi_mid(popnum), n_mid(popnum), di_mid(popnum), cont_mid(popnum)
   ReDim choose1(popnum), BZ(popnum)
   Dim mid_dim()
   ReDim mid_dim(popnum, 2)
   Dim quan1(2, 6), quan2(2, 6), quan3, quan4
   Dim q(10, 100) As Double
   Dim wi(100) As Double
   Dim qs(10000, 100) As Double
   Dim aa(1000, 100) As Double
   
  ''''
  Dim Y(200), SIG(200), A(50), CVM(50, 50)
  Dim u(200, 50), V(50, 50), W(50), uu(200, 50)
   '''''
    
    
   If sel_bz = 1 Then
    Open App.Path + "\yixing.txt" For Input As #1
    Open App.Path + "\out.txt" For Output As #2
   Else
    Open App.Path + "\qo2.dat" For Input As #1
    Open App.Path + "\qo2.out" For Output As #2
   End If
   
    SPREAD = 0.02
    npol = 6 '表示回归系数的总数
    
   i = 0
   While Not EOF(1)
    i = i + 1
    For j = 1 To 6
    Input #1, q(j, i)
    u(i, j) = q(j, i)
    uu(i, j) = u(i, j)
    Next j
    Y(i) = q(1, i)
    u(i, 1) = 1#
     SIG(i) = SPREAD
   Wend
   Close #1
   qnum = i
   
   
   
   
   
    'Polynomial fi
    IDUM& = -911
    mp = qnum '样本数据总数
    NP = npol '回归系数总数
  
    
   '初始群体的生成
   If sel_bz = 1 Then
    cont(0) = q(1, 1)
    'qi0 = q(1): n0 = 0.5: di0 = 0.5
    'qi0 = 50: n0 = 0.5: di0 = 50.5
    For i = 1 To 5
    tao(0, i) = 0.6
    lamd(0, i) = 0.5
    Next i
   Else
    qi0 = 300: n0 = 55.66: di0 = 85.76
   End If
   sum_sum_jsq = 0
10 For i = 1 To 5
    For j = 1 To 5
    quan1(1, j) = -tao(0, i)
    quan1(2, j) = tao(0, i)
    quan2(1, j) = -lamd(0, i)
    quan2(2, j) = lamd(0, i)
    Next j
    tao(1, i) = tao(0, i)
    lamd(1, i) = lamd(0, i)
   Next i
   quan3 = -cont(0): quan4 = cont(0)
   cont(1) = cont(0)
'   quan(1, 1) = -qi0: quan(2, 1) = qi0  'qi
'   quan(1, 2) = -n0: quan(2, 2) = n0   'n
'   quan(1, 3) = -di0: quan(2, 3) = di0  'di
'   qi(1) = qi0: n(1) = n0: di(1) = di0
'   qi(2) = 25.246: n(2) = 2.827: di(2) = 7.382
'   qi(3) = 26.38: n(3) = 2.802: di(3) = 1 / 0.1339
'   qi(4) = 18.65582: n(4) = 3: di(4) = 1 / 0.14581
'   qi(5) = 36.73: n(5) = 2.6132: di(5) = 1 / 0.8845
'   qi(6) = 27.881: n(6) = 2.785: di(6) = 7.46
   Randomize
   For i = 2 To Int(popnum / 2)
     For j = 1 To 5
2     tao(i, j) = tao(0, j) + Rnd * quan1(1, j)
       If sel_bz = 1 And (tao(i, j) < 0) Then GoTo 2
    'qi(i) = qi0 + Rnd * quan(1, 1) ' '生成数据在[0,qi0]之间
22    lamd(i, j) = lamd(0, j) + (Rnd + 0.0001) * quan2(1, j)
    If sel_bz = 1 And (lamd(i, j) < 0 Or lamd(i, j) > 1) Then GoTo 22
 '  n(i) = n0 + (Rnd + 0.0001) * quan(1, 2) '
   
   ' di(i) = di0 + Rnd * quan(1, 3) '
     Next j
     cont(i) = cont(0) + Rnd * quan3
   Next i
   For i = Int(popnum / 2) + 1 To popnum
     For j = 1 To 5
111    tao(i, j) = tao(0, j) + Rnd * quan1(2, j) '
    If sel_bz = 1 And (tao(i, j) < 0) Then GoTo 111
33   lamd(i, j) = lamd(0, j) + (Rnd + 0.0001) * quan2(2, j) '
    If sel_bz = 1 And (lamd(i, j) < 0 Or lamd(i, j) > 1) Then GoTo 33
    Next j
    cont(i) = cont(0) + Rnd * quan4
   Next i
   '适应度评估检测
   sumjsq = 0
1  max_funsy = -9999999
   min_funsy = 9999999
   For i = 1 To popnum
    funsy(i) = 0
    For j = 1 To qnum
     'If j > qnum / 2 Then quanxs = 1 Else quanxs = 1
     qq = 0#
   For k = 1 To 5 'k表示注入井标号
     wi(k) = 0
     For M = 1 To j '求滤波注入量
      'wi(j) = wi(j) + 1 / x(j + 4) * Exp((m - i) / x(j + 4)) * q(j, m)
           wi(k) = wi(k) + (Exp((M - j) / tao(i, k)) - Exp((M - 1 - j) / tao(i, k))) * q(k + 1, M)
      Next M
      u(j, 1) = 0# '考虑是否包含有常数项
'      u(j, k + 1) = q(k + 1, j)
'      Print #2, u(j, k + 1),
      u(j, k + 1) = wi(k) '带入最小二乘里的因变量数据
      uu(j, k + 1) = u(j, k + 1)
     Next k
     
'     Print #2,
'     For k = 1 To 5 '求产量
'     'qq = qq + wi(k)
'     qq = qq + lamd(i, k) * wi(k)
'     Next k
     'qq = qq + cont(i)
     SIG(j) = SPREAD
   
    Next j
    
   
    
    Call SVDFIT(Y(), SIG(), qnum, A(), npol, u(), V(), W(), mp, NP, CHISQ, "FPOLY") 'u()表示最小二乘法系数对应的输入数据
    Call SVDVAR(V(), npol, NP, W(), CVM(), npol)
    
    
    For j = 1 To qnum
    sum11 = A(1)
    aa(i, 1) = A(1)
      For M = 2 To npol
          
            sum11 = sum11 + A(M) * uu(j, M)
             aa(i, M) = A(M)
      Next M
     
      qs(i, j) = sum11
      funsy(i) = funsy(i) + Abs(q(1, j) - sum11) / q(1, j)
    Next j
     
    funsy(i) = qnum / funsy(i)
    If funsy(i) > max_funsy Then max_funsy = funsy(i): max_i = i
    If funsy(i) < min_funsy Then min_funsy = funsy(i): min_i = i
    'Print #2, max_funsy, min_funsy, max_i, min_i, A(1), A(2), A(3), A(4), A(5), A(6)
'     Print #2, i, funsy(i), A(1), A(2), A(3), A(4), A(5), A(6)
   Next i
   
   Print #2, max_funsy, min_funsy, max_i, min_i,
   For i = 1 To 6
'   Print #2, lamd(max_i, i),
    Print #2, aa(max_i, i),

   Next i

   For i = 1 To 5
   Print #2, tao(max_i, i),
   Next i

   Print #2,
   'qi (max_i), n(max_i), di(max_i)
'   If sumjsq < 5 Or Int(sumjsq / 5) * 5 = sumjsq Then
    yaxis_num = 1
   
    ReDim yaxis_grnum(yaxis_num), yaxis_type(yaxis_num)
    ReDim yaxis_min(yaxis_num), yaxis_max(yaxis_num), yaxis_interval(yaxis_num)
    ReDim yaxis_name$(yaxis_num, 3), yaxis_format$(yaxis_num)
   
    Call init_data
    title_name$ = ""

    xaxis_name$ = "年月"
    xaxis_min = 0: xaxis_max = qnum: xaxis_interval = xaxis_max / 2
    xaxis_type = 2: ReDim grdatx_str$(xaxis_max)
    For i = 1 To xaxis_max
     grdatx_str$(i) = i
    Next i
   
   
    yaxis_grnum(1) = 2
    yaxis_name$(1, 1) = "产液"
    yaxis_format$(1) = "###0.0"
     
    grpoint(1) = qnum: grnote_visible(1) = 0
    gr_type(1) = 1
    grpoint(2) = qnum: grnote_visible(2) = 0
    gr_type(2) = 1
    
'    Print #2, sumjsq
    For i = 1 To qnum
     grdaty(1, i) = q(1, i)
     
      qq = 0#
'     For k = 1 To 5
'     wi(k) = 0
'
'     For M = 1 To i '求滤波注入量
'      'wi(j) = wi(j) + 1 / x(j + 4) * Exp((m - i) / x(j + 4)) * q(j, m)
'      wi(k) = wi(k) + (Exp((M - i) / tao(max_i, k)) - Exp((M - 1 - i) / tao(max_i, k))) * q(k + 1, M)
'      Next M
'     u(i, k + 1) = wi(k)
'     Next k
'     For k = 1 To 5 '求产量
'     qq = qq + lamd(max_i, k) * wi(k)
'     Next k
     
      grdaty(2, i) = qs(max_i, i)
      
      If (sumjsq > 5 And max_funsy > 6000) Or sumjsq > 15 Then '输出计算数据
      Print #2, q(1, i), qs(max_i, i)
      End If
    
    Next i
   
    Picture1.Refresh
    Call plotg_main(Me.Picture1)
    Print sumjsq, max_funsy
'   End If
'   Text1.Text = Trim$(Str$(sumjsq))
'   Text2.Text = Format$(max_funsy, "###0.00000")
'   SSPanel1.Caption = Trim$(Str$(sumjsq))
'   SSPanel2.Caption = Format$(max_funsy, "###0.00000")
'   SSPanel3.Caption = Format$(qi(max_i), "###0.000")
'   SSPanel4.Caption = Format$(n(max_i), "###0.000")
'   SSPanel5.Caption = Format$(di(max_i), "###0.000")
'   If sum_sum_jsq > 1 And sumjsq > 15 Then GoTo 100   '1>50
'   If sum_sum_jsq <= 1 And sumjsq > 5 Then '当进化到第六代是将目前最优值赋回到最初值；1表示赋回到初值的次数
  If (sumjsq > 5 And max_funsy > 6000) Or sumjsq > 15 Then
'    Print #2, sum_sum_jsq, sumjsq
'    For i = 1 To popnum
'      For j = 1 To 5
'      Print #2, lamd(i, j),
'      Next j
'
'      For j = 1 To 5
'      Print #2, tao(i, j),
'      Next j
'
'     Print #2,
'    Next i
'
'    For i = 1 To 5
'    tao(0, i) = tao(max_i, i)
'    lamd(0, i) = lamd(max_i, i)
'    Next i
    'qi0 = qi(max_i): n0 = n(max_i): di0 = di(max_i)
'    sum_sum_jsq = sum_sum_jsq + 1
'
'    GoTo 10
   GoTo 100
   End If
   '选择
   Sum_funsy = 0
   For i = 1 To popnum
    'funsy(i) = (funsy(i) - min_funsy) / (max_funsy - min_funsy) * 0.01 + min_funsy
    Sum_funsy = Sum_funsy + funsy(i)
   Next i
   jsq = 0
   For i = 1 To popnum
    funsy(i) = Int(funsy(i) / Sum_funsy * popnum + 0.5)
    jsq = jsq + funsy(i)
   Next i
   If jsq <> popnum Then
    If jsq > popnum Then
     For i = 1 To Abs(jsq - popnum)
      mid_dim(i, 1) = 999
     Next i
     For i = 1 To popnum
      For j = 1 To Abs(jsq - popnum)
       If funsy(i) < mid_dim(j, 1) And funsy(i) <> 0 Then mid_dim(j, 1) = funsy(i): mid_dim(j, 2) = i: GoTo 5
      Next j
5    Next i
     For i = 1 To Abs(jsq - popnum)
      funsy(mid_dim(i, 2)) = funsy(mid_dim(i, 2)) - 1
     Next i
    Else
     For i = 1 To Abs(jsq - popnum)
      mid_dim(i, 1) = -999
     Next i
     For i = 1 To popnum
      For j = 1 To Abs(jsq - popnum)
       If funsy(i) > mid_dim(j, 1) And funsy(i) <> 0 Then mid_dim(j, 1) = funsy(i): mid_dim(j, 2) = i: GoTo 6
      Next j
6    Next i
     For i = 1 To Abs(jsq - popnum)
      funsy(mid_dim(i, 2)) = funsy(mid_dim(i, 2)) + 1
     Next i
    End If
   End If
   jsq = 0
   For i = 1 To popnum
    BZ(i) = 0
   Next i
   For i = 1 To popnum
    If funsy(i) > 0 Then
     For j = 1 To funsy(i)
      jsq = jsq + 1
      For k = 1 To 5
      lamd_mid(jsq, k) = lamd(i, k)
      tao_mid(jsq, k) = tao(i, k)
      Next k
      cont_mid(jsq) = cont(i)
'      qi_mid(jsq) = qi(i)
'      n_mid(jsq) = n(i)
'      di_mid(jsq) = di(i)
      If i = max_i And j = 1 Then BZ(jsq) = 1
     Next j
    End If
   Next i
   For i = 1 To popnum
    For k = 1 To 5
     lamd(i, k) = lamd_mid(i, k)
      tao(i, k) = tao_mid(i, k)
    Next k
    cont(i) = cont_mid(i)
'    qi(i) = qi_mid(i)
'    n(i) = n_mid(i)
'    di(i) = di_mid(i)
   Next i
   '配对
   pcnum = Int(pc * popnum / 2)
   Randomize
   For i = 1 To popnum
    choose1(i) = -1
   Next i
   For i = 1 To pcnum * 2
    If i > 1 Then
8    midval = Int((popnum * Rnd) + 1)
     If BZ(midval) = 1 Then GoTo 8
     For j = 1 To i - 1
      If choose1(j) = midval Then GoTo 8
     Next j
     choose1(i) = midval
    Else
60   choose1(i) = Int((popnum * Rnd) + 1)
     If BZ(choose1(i)) = 1 Then GoTo 60
    End If
   Next i
   For i = 1 To pcnum
    Randomize
    choosexh = Int((5 * Rnd) + 1)
    For j = 1 To 5
     If j <> choosexh Then
'      Select Case j
'       Case 1:
        For k = 1 To 5
        mid1 = arel * lamd(choose1(i), k) + (1 - arel) * lamd(choose1(2 * pcnum - i + 1), k)
         mid2 = (1 - arel) * lamd(choose1(i), k) + arel * lamd(choose1(2 * pcnum - i + 1), k)
'        If Abs(mid1) < 0.0001 Then mid1 = 0.5
'        If Abs(mid2) < 0.0001 Then mid2 = 0.5
'        If sel_bz = 1 Then
'         If mid1 < 0 Or mid1 > 1 Then mid1 = 0.5
'         If mid2 < 0 Or mid2 > 1 Then mid2 = 0.5
'        End If
           lamd(choose1(i), k) = mid1
        lamd(choose1(2 * pcnum - i + 1), k) = mid2
        Next k
        cont(choose1(i)) = arel * cont(choose1(i)) + (1 - arel) * cont(choose1(2 * pcnum - i + 1))
       'mid1 = arel * qi(choose1(i)) + (1 - arel) * qi(choose1(2 * pcnum - i + 1))
'        mid1 = arel * qi(choose1(i)) + (1 - arel) * qi(choose1(2 * pcnum - i + 1))
'        mid2 = (1 - arel) * qi(choose1(i)) + arel * qi(choose1(2 * pcnum - i + 1))
'        qi(choose1(i)) = mid1
'        qi(choose1(2 * pcnum - i + 1)) = mid2
'       Case 2: