frmmain.frm

遗传算法的实现（转载）

            y2 = m_pts(i).y
            x4 = x0 + x2 * sngScale
            y4 = y0 - y2 * sngScale
            p.Line (x3, y3)-(x4, y4)
            
        Next
    End If
End Sub
Public Function init() As Boolean
    Dim i, j, k As Long
    Randomize
    pg.Max = g.maxgeneration
    
    InitKnapSack    'initialize KnapSack data
    InitBin         'initialize Bin packing data

    
    menuFuns_Click (0)
    
End Function

Public Function Decoding(ByVal genome As GALib.IGenome) As String
    Dim x As Single
    Dim i As Long, idx As Long, lInc As Long
    idx = 0
    If m_lFunID <> cstKNAPSACK Then
        For i = 1 To m_allelesetarr(0).Size / 10
            lInc = genome.getbitslong(idx, idx + 9)
            x = -5.12 + 0.01 * lInc
            If i <> 10 Then
                Decoding = Decoding + Format(x, "#0.00") + "=>"
            Else
                Decoding = Decoding + Format(x, "#0.00")
            End If
            idx = idx + 10
        Next
    Else
        For i = 1 To m_allelesetarr(0).Size
            lInc = genome(i - 1)
            If i <> m_allelesetarr(0).Size Then
                Decoding = Decoding + CStr(lInc) + "=>"
            Else
                Decoding = Decoding + CStr(lInc)
            End If
        Next
    End If
End Function

'==================================



Public Function InitPop(Index As Integer)
    Dim gTemplate As New genome 'sample genome
    Dim k As Long
    Dim bret As Boolean
    Dim aset As AlleleSet
    
    m_allelesetarr.deleteArray  'reset alleleset array
    
    If menuReal.Checked = True Then     'create alleles for real genomes
        If m_lFunID = cstFUNRAS Then
            bret = m_allelesetarr.newArray(10)
            Set aset = m_allelesetarr(0)
            Call aset.newDiscrete(-5.12, 5.12, 0.001, GABOUND_INCLUSIVE, GABOUND_INCLUSIVE)
            For k = 1 To 9
                Call m_allelesetarr.link(k, 0)
            Next
            txt = "Objective Function: 10×n+ ∑[x(i)×x(i)-10×cos(2πx(i))]   (n=10)"
            InitParameters GA_CROWDINGGA, GA_RANDOMINITIALIZER, GA_UNIFORMCROSSOVER, _
                GA_GAUSSIANMUTATOR, GA_MINIMIZE, GA_ROULETTEEWHEELSELECTOR, 150, 100, 0.9, 0.01
        ElseIf m_lFunID = cstFUNACKLEY Then
                bret = m_allelesetarr.newArray(10)
                Set aset = m_allelesetarr(0)
                Call aset.newDiscrete(-32, 32, 0.001, GABOUND_INCLUSIVE, GABOUND_INCLUSIVE)
            For k = 1 To 9
                Call m_allelesetarr.link(k, 0)
            Next
            txt = "Objective Function: 20+e+ [20×exp(-0.2×(sqrt((1/n)×∑(x(i)^2))-exp((1/n)∑(cos(2×Pi×x(i)))]   (n=10)"
            InitParameters GA_CROWDINGGA, GA_RANDOMINITIALIZER, GA_UNIFORMCROSSOVER, _
                GA_GAUSSIANMUTATOR, GA_MINIMIZE, GA_ROULETTEEWHEELSELECTOR, 150, 100, 0.9, 0.01
        
        ElseIf m_lFunID = cstFUNSPHERE Then
                bret = m_allelesetarr.newArray(10)
                Set aset = m_allelesetarr(0)
                Call aset.newDiscrete(-5.12, 5.12, 0.001, GABOUND_INCLUSIVE, GABOUND_INCLUSIVE)
            For k = 1 To 9
                Call m_allelesetarr.link(k, 0)
            Next
            txt = "Objective Function: ∑[x(i)-5+i]^2   (n=10)"
            InitParameters GA_CROWDINGGA, GA_RANDOMINITIALIZER, GA_UNIFORMCROSSOVER, _
                GA_GAUSSIANMUTATOR, GA_MINIMIZE, GA_ROULETTEEWHEELSELECTOR, 150, 100, 0.9, 0.01
       
       ElseIf m_lFunID = cstFUNTSP Or m_lFunID = cstFUNTSP2 Then
                bret = m_allelesetarr.newArray(24)
                Set aset = m_allelesetarr(0)
                Call aset.newEnumerator(24)
            For k = 1 To 23
                Call m_allelesetarr.link(k, 0)
            Next
            For k = 1 To 24
                aset(k - 1) = k
            Next
            If m_lFunID = cstFUNTSP Then
                txt = "Circle TSP Problem"
                CircleTSP   'initialize tsp data
            Else
                txt = "Random TSP Problem"
                RandomTSP  'initialize tsp data
            End If
            InitParameters GA_SIMPLEGA, GA_ORDERINITIALIZER, GA_CUSTOMCROSSOVER _
                , GA_SWAPMUTATOR, GA_MINIMIZE, GA_ROULETTEEWHEELSELECTOR, 500, 50, 0.9, 0.04
            
       ElseIf m_lFunID = cstKNAPSACK Then
            bret = m_allelesetarr.newArray(50)
            Set aset = m_allelesetarr(0)
            Call aset.newDiscrete(0, 1, 1, GABOUND_INCLUSIVE, GABOUND_INCLUSIVE)
            For k = 1 To 49
                Call m_allelesetarr.link(k, 0)
            Next
            txt = "A single knapsack problem with 50 objects"
            InitParameters GA_CROWDINGGA, GA_RANDOMINITIALIZER, GA_UNIFORMCROSSOVER, _
                GA_GAUSSIANMUTATOR, GA_MAXIMIZE, GA_ROULETTEEWHEELSELECTOR, 150, 100, 0.9, 0.01
       
       ElseIf m_lFunID = cstBIN Then
            bret = m_allelesetarr.newArray(60)
            Set aset = m_allelesetarr(0)
            Call aset.newEnumerator(60)
            For k = 1 To 59
                Call m_allelesetarr.link(k, 0)
            Next
            For k = 0 To 59
                aset(k) = k
            Next
            txt = "60 objects in 'triplets' of items from (25,50), bins of size 100"
            InitParameters GA_SIMPLEGA, GA_ORDERINITIALIZER, GA_ORDERCROSSOVER _
                , GA_SWAPMUTATOR, GA_MINIMIZE, GA_TOURNAMENTSELECTOR, 500, 100, _
                1, 0.003
       ElseIf m_lFunID = cstSTEINER Or m_lFunID = cstSTEINER2 Then
            m_allelesetarr.newArray (2)
            Set aset = m_allelesetarr(0)
            Call aset.newDiscrete(-100, 100, 0.01, GABOUND_INCLUSIVE, GABOUND_INCLUSIVE)
            m_allelesetarr.link 1, 0
            CircleTSP
           txt = "Steiner's Problem"
           InitParameters GA_CROWDINGGA, GA_RANDOMINITIALIZER, GA_SINGLEPOINTCROSSOVER _
                , GA_GAUSSIANMUTATOR, GA_MINIMIZE, GA_ROULETTEEWHEELSELECTOR, 150, 50, 0.9, 0.01
           
       End If
       gTemplate.Type = GA_REALGENOME  'set genome type
    Else                                'create alleles for binary genomes
        If m_lFunID = cstFUNRAS Then
                m_allelesetarr.newArray (1)
                Set aset = m_allelesetarr(0)
                Call aset.newBinary(50)
                txt = "Objective Function: 10×n+ ∑[x(i)×x(i)-10×cos(2πx(i))]   (n=5)"
                InitParameters GA_STEADYGA, GA_RANDOMINITIALIZER, GA_SINGLEPOINTCROSSOVER _
                , GA_FLIPMUTATOR, GA_MINIMIZE, GA_TOURNAMENTSELECTOR, 250, 300, 0.9, 0.01
        
        ElseIf m_lFunID = cstFUNACKLEY Then
                m_allelesetarr.newArray (1)
                Set aset = m_allelesetarr(0)
                Call aset.newBinary(100)
                txt = "Objective Function: 10×n+ ∑[x(i)×x(i)-10×cos(2πx(i))]   (n=10)"
                InitParameters GA_STEADYGA, GA_RANDOMINITIALIZER, GA_SINGLEPOINTCROSSOVER _
                , GA_FLIPMUTATOR, GA_MINIMIZE, GA_TOURNAMENTSELECTOR, 250, 300, 0.9, 0.01
        
        ElseIf m_lFunID = cstFUNSPHERE Then
                m_allelesetarr.newArray (1)
                Set aset = m_allelesetarr(0)
                Call aset.newBinary(100)
                txt = "Objective Function: ∑[x(i)-5+i]^2   (n=10)"
                InitParameters GA_STEADYGA, GA_RANDOMINITIALIZER, GA_SINGLEPOINTCROSSOVER _
                , GA_FLIPMUTATOR, GA_MINIMIZE, GA_TOURNAMENTSELECTOR, 250, 300, 0.9, 0.01
        
        ElseIf m_lFunID = cstFUNTSP Or m_lFunID = cstFUNTSP2 Or m_lFunID = cstBIN Then
                txt = "Not implemented"
                Exit Function
        ElseIf m_lFunID = cstKNAPSACK Then
                m_allelesetarr.newArray (1)
                Set aset = m_allelesetarr(0)
                Call aset.newBinary(50)
                txt = "A single knapsack problem with 50 objects"
                InitParameters GA_STEADYGA, GA_RANDOMINITIALIZER, GA_SINGLEPOINTCROSSOVER _
                , GA_FLIPMUTATOR, GA_MAXIMIZE, GA_TOURNAMENTSELECTOR, 250, 300, 0.9, 0.02
        
        End If
        gTemplate.Type = GA_BINARYGENOME    'set genome type
    End If
    m_allelesetarr.init                                 'initialization of all alleles
    gTemplate.AlleleSetArray = m_allelesetarr           'define alleles
    gTemplate.newGenome             'create a genome
    m_Pop.newPopulation , gTemplate 'create population based on gTemplate
    Set g.population = m_Pop                            'assign the population to G+
    
    If m_lFunID = cstFUNTSP Or m_lFunID = cstFUNTSP2 Then 'for TSP to improve speed
        Dim i As Long
        For i = 0 To 5
            g.population.best(i).mutator = GA_CUSTOMMUTATOR
        Next
    End If
    
End Function

Public Function InitParameters(ag As GAAlgorithmType, init As GAInitializerType, _
    cos As GACrossoverType, mut As GAMutatorType, obj As GAMaxMinType, _
    sel As GASelector, maxgen As Long, popsize As Long, pcos As Single, pmut As Single)
    g.algorithm = ag
    g.definitializer = init
    g.Crossover = cos
    g.defmutator = mut
    g.maximini = obj
    g.maxgeneration = maxgen
    g.defpopsize = popsize
    g.pcrossover = pcos
    g.pmutation = pmut
    g.defselector = sel
    pg.Value = 0
    pg.Max = g.maxgeneration
End Function









'===FUNCTIONS FOR INITIALIZE DATA
Public Sub InitBin()
m_w(0) = 32.9
m_w(1) = 36.1
m_w(2) = 25.7
m_w(3) = 38.2
m_w(4) = 39.1
m_w(5) = 25.9
m_w(6) = 35#
m_w(7) = 39.5
m_w(8) = 26.3
m_w(9) = 34.2
m_w(10) = 42.7
m_w(11) = 25.7
m_w(12) = 31.6
m_w(13) = 45.9
m_w(14) = 25.5
m_w(15) = 28.6
m_w(16) = 36.7
m_w(17) = 27#
m_w(18) = 36.3
m_w(19) = 46#
m_w(20) = 26.7
m_w(21) = 27.3
m_w(22) = 45.9
m_w(23) = 25.9
m_w(24) = 28.2
m_w(25) = 49.3
m_w(26) = 25.3
m_w(27) = 25.4
m_w(28) = 46#
m_w(29) = 25.3
m_w(30) = 28.7
m_w(31) = 36.6
m_w(32) = 29.2
m_w(33) = 34.2
m_w(34) = 47#
m_w(35) = 25.4
m_w(36) = 27.6
m_w(37) = 40.5
m_w(38) = 25.2
m_w(39) = 34.3
m_w(40) = 49.9
m_w(41) = 25#
m_w(42) = 25.1
m_w(43) = 48.8
m_w(44) = 25.1
m_w(45) = 26.1
m_w(46) = 38.4
m_w(47) = 25.8
m_w(48) = 35.8
m_w(49) = 40.7
m_w(50) = 28.8
m_w(51) = 30.5
m_w(52) = 41.5
m_w(53) = 26.1
m_w(54) = 32.4
m_w(55) = 42.3
m_w(56) = 27.9
m_w(57) = 29.8
m_w(58) = 36.8
m_w(59) = 30.3
m_w(60) = 32.9
End Sub
Public Sub InitKnapSack()
m_knap(1).p = 23
m_knap(2).p = 21
m_knap(3).p = 37
m_knap(4).p = 28
m_knap(5).p = 27
m_knap(6).p = 21
m_knap(7).p = 6
m_knap(8).p = 38
m_knap(9).p = 7
m_knap(10).p = 11
m_knap(11).p = 49
m_knap(12).p = 23
m_knap(13).p = 27
m_knap(14).p = 15
m_knap(15).p = 0
m_knap(16).p = 17
m_knap(17).p = 17
m_knap(18).p = 5
m_knap(19).p = 41
m_knap(20).p = 32
m_knap(21).p = 32
m_knap(22).p = 21
m_knap(23).p = 28
m_knap(24).p = 0
m_knap(25).p = 25
m_knap(26).p = 30
m_knap(27).p = 5
m_knap(28).p = 11
m_knap(29).p = 41
m_knap(30).p = 28
m_knap(31).p = 42
m_knap(32).p = 22
m_knap(33).p = 35
m_knap(34).p = 13
m_knap(35).p = 14
m_knap(36).p = 46
m_knap(37).p = 2
m_knap(38).p = 34
m_knap(39).p = 32
m_knap(40).p = 15
m_knap(41).p = 48
m_knap(42).p = 39
m_knap(43).p = 3
m_knap(44).p = 40
m_knap(45).p = 28
m_knap(46).p = 16
m_knap(47).p = 17
m_knap(48).p = 31
m_knap(49).p = 19
m_knap(50).p = 0
m_knap(1).w = 1
m_knap(2).w = 4
m_knap(3).w = 2
m_knap(4).w = 28
m_knap(5).w = 47
m_knap(6).w = 2
m_knap(7).w = 23
m_knap(8).w = 12
m_knap(9).w = 12
m_knap(10).w = 45
m_knap(11).w = 21
m_knap(12).w = 29
m_knap(13).w = 36
m_knap(14).w = 43
m_knap(16).w = 1
m_knap(17).w = 38
m_knap(18).w = 4
m_knap(19).w = 33
m_knap(20).w = 18
m_knap(21).w = 3
m_knap(22).w = 38
m_knap(23).w = 11
m_knap(24).w = 35
m_knap(25).w = 13
m_knap(26).w = 29
m_knap(27).w = 3
m_knap(28).w = 32
m_knap(29).w = 26
m_knap(30).w = 21
m_knap(31).w = 47
m_knap(32).w = 9
m_knap(33).w = 29
m_knap(34).w = 26
m_knap(35).w = 47
m_knap(36).w = 46
m_knap(37).w = 19
m_knap(38).w = 30
m_knap(39).w = 34
m_knap(40).w = 8
m_knap(41).w = 48
m_knap(42).w = 5
m_knap(43).w = 0
m_knap(44).w = 45
m_knap(45).w = 20
m_knap(46).w = 22
m_knap(47).w = 40
m_knap(48).w = 4
m_knap(49).w = 49
m_knap(50).w = 0
End Sub
Public Sub CircleTSP()
    'Get TSP Circle DATA
    m_pts(1).x = 100#: m_pts(1).y = 0#
    m_pts(2).x = 96.593: m_pts(2).y = 25.882
    m_pts(3).x = 86.603: m_pts(3).y = 50#
    m_pts(4).x = 70.711: m_pts(4).y = 70.711
    m_pts(5).x = 50#: m_pts(5).y = 86.603
    m_pts(6).x = 25.882: m_pts(6).y = 96.593
    m_pts(7).x = 0#: m_pts(7).y = 100#
    m_pts(8).x = -25.882: m_pts(8).y = 96.593
    m_pts(9).x = -50#: m_pts(9).y = 86.603
    m_pts(10).x = -70.711: m_pts(10).y = 70.711
    m_pts(11).x = -86.603: m_pts(11).y = 50#
    m_pts(12).x = -96.593: m_pts(12).y = 25.882
    m_pts(13).x = -100#: m_pts(13).y = 0#
    m_pts(14).x = -96.593: m_pts(14).y = -25.882
    m_pts(15).x = -86.603: m_pts(15).y = -50#
    m_pts(16).x = -70.711: m_pts(16).y = -70.711
    m_pts(17).x = -50#: m_pts(17).y = -86.603
    m_pts(18).x = -25.882: m_pts(18).y = -96.593
    m_pts(19).x = 0#: m_pts(19).y = -100#
    m_pts(20).x = 25.882: m_pts(20).y = -96.593
    m_pts(21).x = 50#: m_pts(21).y = -86.603
    m_pts(22).x = 70.711: m_pts(22).y = -70.711
    m_pts(23).x = 86.603: m_pts(23).y = -50#
    m_pts(24).x = 96.593: m_pts(24).y = -25.882

End Sub
Public Sub RandomTSP()
    Dim i As Long
    For i = 1 To 24
        m_pts(i).x = -100 + Rnd * 200
        m_pts(i).y = 100 - Rnd * 200
    Next
End Sub