form1.frm

来自「水库调度的遗传算法」· FRM 代码 · 共 533 行 · 第 1/2 页

   Data1.Recordset.Fields("4水位末") = upwater_level(bestindex, 12)
   '发电流量
   Data1.Recordset.Fields("5发流量") = Q2(bestindex, 1)
   Data1.Recordset.Fields("6发流量") = Q2(bestindex, 2)
   Data1.Recordset.Fields("7发流量") = Q2(bestindex, 3)
   Data1.Recordset.Fields("8发流量") = Q2(bestindex, 4)
   Data1.Recordset.Fields("9发流量") = Q2(bestindex, 5)
   Data1.Recordset.Fields("10发流量") = Q2(bestindex, 6)
   Data1.Recordset.Fields("11发流量") = Q2(bestindex, 7)
   Data1.Recordset.Fields("12发流量") = Q2(bestindex, 8)
   Data1.Recordset.Fields("1发流量") = Q2(bestindex, 9)
   Data1.Recordset.Fields("2发流量") = Q2(bestindex, 10)
   Data1.Recordset.Fields("3发流量") = Q2(bestindex, 11)
   Data1.Recordset.Fields("4发流量") = Q2(bestindex, 12)
   '弃水流量
   Data1.Recordset.Fields("5弃流量") = QS(bestindex, 1)
   Data1.Recordset.Fields("6弃流量") = QS(bestindex, 2)
   Data1.Recordset.Fields("7弃流量") = QS(bestindex, 3)
   Data1.Recordset.Fields("8弃流量") = QS(bestindex, 4)
   Data1.Recordset.Fields("9弃流量") = QS(bestindex, 5)
   Data1.Recordset.Fields("10弃流量") = QS(bestindex, 6)
   Data1.Recordset.Fields("11弃流量") = QS(bestindex, 7)
   Data1.Recordset.Fields("12弃流量") = QS(bestindex, 8)
   Data1.Recordset.Fields("1弃流量") = QS(bestindex, 9)
   Data1.Recordset.Fields("2弃流量") = QS(bestindex, 10)
   Data1.Recordset.Fields("3弃流量") = QS(bestindex, 11)
   Data1.Recordset.Fields("4弃流量") = QS(bestindex, 12)
   Data1.Recordset.Update
End Sub
Public Sub generatepopulation()
'***把水位的取值划为M等份
For j = 1 To insize  'insize是个体大小
    m(j) = (max_water_level(j) - min_water_level(j)) / 0.05
Next j
'****************生成初始群体
   Randomize
   For i = 1 To popsize
       vm(i, 0) = cha(Z(), V(), 20, zd)                         '由死水位查死库容
       upwater_level(i, 0) = zd                                 '死水位
       For j = 1 To insize
         If j <> 12 Then
           K(i, j) = Int(Rnd * (20 + 1)) * (m(j) / 20)
           upwater_level(i, j) = min_water_level(j) + K(i, j) * (max_water_level(j) - min_water_level(j)) / m(j) '上游水位
           vm(i, j) = cha(Z(), V(), 20, upwater_level(i, j))    '由上游水位查库容
           w(i, j) = vm(i, j - 1) + Q1(j) - vm(i, j)           '下泄水量
           Q2(i, j) = (w(i, j) * 100000000) / (T(j) * 86400)               '下泄流量
           downwater_level(i, j) = cha(Q(), zx(), 53, Q2(i, j)) '由下泄流量查下游水位
           H(i, j) = (upwater_level(i, j) + upwater_level(i, j - 1)) / 2 - downwater_level(i, j)   '水头，暂且不考虑水头损失。
           n(i, j) = 8.5 * Q2(i, j) * H(i, j) * 0.0001         '出力，万KW
         Else
           upwater_level(i, 12) = zd                             '第12个计算时段末水位为死水位
           vm(i, j) = cha(Z(), V(), 20, upwater_level(i, j))     '由上游水位查库容
           w(i, j) = vm(i, j - 1) + Q1(j) - vm(i, j)           '下泄水量
           Q2(i, j) = (w(i, j) * 100000000) / (T(j) * 86400)                 '下泄流量
           downwater_level(i, j) = cha(Q(), zx(), 53, Q2(i, j))  '由下泄流量查下游水位
           H(i, j) = (upwater_level(i, j) + upwater_level(i, j - 1)) / 2 - downwater_level(i, j)   '水头，暂且不考虑水头损失。
           n(i, j) = 8.5 * Q2(i, j) * H(i, j) * 0.0001         '出力，万KW
         End If
       Next j
   Next i
End Sub

Public Sub evaluatepopulation() '计算该群体适应度，然后求出平均适应值
                                '和适应度最高与最差个体
Dim sum As Single
Dim sumnum As Single
 MMM = 50
   For i = 1 To popsize
        sum = 0
        upwater_level(i, 0) = zd
        For j = 1 To insize
            upwater_level(i, j) = min_water_level(j) + K(i, j) * (max_water_level(j) - min_water_level(j)) / m(j) '上游水位
            H(i, j) = (upwater_level(i, j) + upwater_level(i, j - 1)) / 2 - downwater_level(i, j)   '水头，暂且不考虑水头损失。
            n(i, j) = 8.5 * Q2(i, j) * H(i, j) * 0.0001         '出力，万KW。
            QS(i, j) = 0                                        '弃水流量为0。
            '装机容量限制
            If n(i, j) > capacity Then                          '出力大于装机容量
               n(i, j) = 30
               QL = 300000 / (8.5 * H(i, j))                    '发电流量
               QS(i, j) = Q2(i, j) - QL                         '弃水流量
            End If
            '保证出力限制
            If n(i, j) < bzcl And Q2(i, j) < min_Q Then
               'E(i, j) = n(i, j) * T(j) * 24 / 10000 - MMM * (bzcl - n(i, j))    '时段电量(亿度)
               E(i, j) = 0.5 * n(i, j) * T(j) * 24 / 10000
            Else
               E(i, j) = n(i, j) * T(j) * 24 / 10000
            End If
            sum = sum + E(i, j)                                 '累积电量（亿度）
        Next j
           fitness(i) = sum                                    '一年的发电量
   Next i
  '*******************求出群体适应度的平均值
   sunnum = 0
   For i = 1 To popsize
     sumnum = sumnum + fitness(i)
   Next i
   averagefitness = sumnum / popsize
  '******找出当前群体中适应度最高和最差的个体
   bestfitness = fitness(1)
   For i = 1 To popsize
       If fitness(i) >= bestfitness Then
          bestfitness = fitness(i)
          bestindex = i
       End If
   Next i
   worstfitness = fitness(1)
   For i = 1 To popsize
       If fitness(i) <= worstfitness Then
          worstfitness = fitness(i)
          worstindex = i
       End If
   Next i
End Sub
Public Sub selectionoperator()    '选择运算采用轮盘赌的方式

Dim p As Single, flag As Integer
Dim sumnum As Single
Dim pop(500) As Single             '适应值累加比例
'开始
sumnum = 0
For i = 1 To popsize  '计算该代总的适应度值
  sumnum = sumnum + fitness(i)
Next i
popfitness(1) = fitness(1)
For i = 2 To popsize '累加适应值
 popfitness(i) = popfitness(i - 1) + fitness(i)
Next i
'累加适应比例
  For i = 1 To popsize
      pop(i) = popfitness(i) / sumnum
  Next i
'选择
Randomize
  For i = 1 To popsize
      p = 0.3  '选择概率
      flag = 1
      Do While p > pop(flag) And flag < 30
               flag = flag + 1
      Loop
      For j = 1 To insize
          newK(i, j) = K(flag, j)
      Next j
  Next i
  For i = 1 To popsize  '复制操作
      For j = 1 To insize
        K(i, j) = newK(i, j)
      Next j
  Next i
End Sub
Public Sub crossoveroperator() '交叉运算
   Randomize
   For i = 1 To popsize / 2
       If i = 1 Then
          index(i) = Int((popsize / 2 + 1) * Rnd) + popsize / 2
       End If
       
       If i <> 1 Then
1000
          index(i) = Int((popsize / 2 + 1) * Rnd) + popsize / 2
          zzz = index(i)
          For r = 1 To (i - 1)
              If index(r) = zzz Then
                 GoTo 1000
              End If
          Next r
       End If
   Next i
    
    For i = 1 To popsize
      For j = 1 To insize
          k1(i, j) = K(i, j)
      Next j
    Next i

    Randomize
    For i = 1 To popsize / 2
        crossover_position = Int(insize * Rnd + 1) '交叉点
        For j = crossover_position To insize
            k1(i, j) = K(index(i), j)
            k1(index(i), j) = K(i, j)
        Next j
    Next i
End Sub
Public Sub mutationoperator() '变异运算,采用非均匀变异开始（基本完整）
    b = 3                                    '形状系数
    s = l / Maxgen                           '进化标计
    Randomize
    For i = 1 To popsize
        a2 = Int((insize - 1) * Rnd + 1)    '确定变异基因位
        a3 = Int(Rnd * 2 + 1)
        If a3 = 1 Then
           y = m(a2) - k1(i, a2)
        Else
           y = k1(i, a2) - 0
        End If
        ss = Rnd
        d = y * (1 - ss ^ ((1 - s) * b))
        If a3 = 1 Then
           k1(i, a2) = k1(i, a2) + d
        Else
           k1(i, a2) = k1(i, a2) - d
        End If
    Next i
'******非均匀变异结束
End Sub
Public Sub generatenextpopulation() '产生下一代群体
 
 Call selectionoperator  '选择算子
 Call crossoveroperator  '交叉算子
 Call mutationoperator   '变异算子
 For i = 1 To popsize
   For j = 1 To insize
      K(i, j) = k1(i, j)
   Next j
 Next i
End Sub



Private Sub Command2_Click()
   End
End Sub

Private Sub Form_Load()

Data1.DatabaseName = App.Path + "\资料数据库.mdb"

Data1.RecordSource = "select * from 水位库容表"
Data1.Refresh
Data1.Recordset.MoveLast
aa = Data1.Recordset.RecordCount
Data1.Recordset.MoveFirst
For i = 1 To aa
    Z(i) = Data1.Recordset.Fields("水位")
    V(i) = Data1.Recordset.Fields("库容")
    Data1.Recordset.MoveNext
Next i

Data1.RecordSource = "select * from 下泄流量下游水位表"
Data1.Refresh
Data1.Recordset.MoveLast
bb = Data1.Recordset.RecordCount
Data1.Recordset.MoveFirst
For i = 1 To bb
    zx(i) = Data1.Recordset.Fields("下游水位") '下泄曲线
    Q(i) = Data1.Recordset.Fields("下泄流量")
    Data1.Recordset.MoveNext
Next i

Data1.RecordSource = "select * from 入库流量表"
Data1.Refresh
Data1.Recordset.MoveLast
cc = Data1.Recordset.RecordCount
Data1.Recordset.MoveFirst
For i = 1 To cc
    Q1(i) = Data1.Recordset.Fields("入库流量")
    T(i) = Data1.Recordset.Fields("月天数")
    Q1(i) = Q1(i) * T(i) * 86400 / 100000000
    Data1.Recordset.MoveNext
Next i

Data1.Visible = False
End Sub