免費論壇 繁體 | 簡體
Sclub交友聊天~加入聊天室當版主
分享
返回列表 回復 發帖

人工智慧之基因演算法VB.NET程式設計參考

http://tw.myblog.yahoo.com/torex-blog/article?mid=588

基因演算法(Genetic Algorithm(GA)):是最佳化工程計算常用的一種演算工具,於1975年由密西根大學John Holland教授及他的學生首先提出之演算法則。基因演算法源自於自然界中”物競天擇”及”適者生存”的特性,模擬生物間的競爭,倖存者得以繁衍下一代的觀念,應用於最佳化工程之計算時,以隨機方式同時產生多組解,較佳的解將被留下運算,如此多次疊代即可求出最佳解。

傳統之演算法往往由幾個起始點,依照一定的數學模式產生下一次疊代值,如此反覆計算求得最佳解﹔而基因演算法以隨機方式產生許多的點,同時搜尋最佳解,因為在每一次疊代過程皆是取相對最佳的點,因此只能找到最接近之最佳解。不過因為其他演算可能也只找到局部最佳解(Local Optimum)而不能保證是真正的最佳解(Global Optimum)。所以基因演算法長相當不錯的最佳化運算工具。 1975年 John Holland提出以基因遺傳演算法來解決數學最佳化的問題,經過多年研究發展已成功應用在物理、工業工程、電腦資訊,甚至財物金融等研究及應用領域的最佳化問題求解。基因遺傳演算法主要啟發自達爾文的進化論:物競天擇、強者生存的定律;模擬生物基因(gene)有擇優(Selection)、交配(Crossover)及突變(Mutation)的能力,使產生更優秀的新生代的程序;將要解的最佳化問題轉化為染色體及基因的模型,再藉著基因擇優、交配及突變的過程去尋求最佳解。
類神經路網路(Neural Network):
自從McCulloch和Pitts在1943年提出第一個神經元(Neuron)的運算模型以來,類神經網路的研究大門便從此敞開。類神經網路是由模擬人類心智和腦部活動所發展出來的一種模型。就網路的架構而言,它是由許多簡單而且相互連結的神經元所組成;就網路的功能而言它是啟發自人類腦部活動所產生出來新型態的資訊處理和計算方式。目前類神經網路的研究除了應用在影像處理、語音辨識、文字辨識、控制等領域外,應用在最佳化上也是許多學者努力研究的目標。
螞蟻演算法(Ant Algorithm):
螞蟻演算法最早是由M. Dorigo於1992年他的博士論文所提出,其發展主要是起源於觀察螞蟻之移動行為,螞蟻移動時會分泌一種稱為費洛蒙(Pheromone)之荷爾蒙,螞蟻行經一路徑之機會與該路徑曾遺留之費洛蒙成正比。越多螞蟻走過一個路程則遺留之費洛蒙越多,而遺留越多費洛蒙又會吸引越多螞蟻行走該路徑。因此,當螞蟻面臨兩條路以上之抉擇時,其行走某一路線之機率與其遺留費洛蒙量有關,而越短之路線其螞蟻通過時間短,導致最短路線上遺留之費洛蒙量越多,進而誘使更多螞蟻行經最短路徑,最後所有螞蟻將往最短路徑行走。較短之路徑所需行經時間較短,容易累積較多之費洛蒙,因而吸引較多之螞蟻,最後螞蟻將沿最短路徑,而求得最佳解。蟻行演算法即在模仿螞蟻行為,以進行最佳化之搜尋工作。螞蟻演算法可應用在最短路徑、旅行推銷員問題( TSP )、生產排程、水庫最低水位...等最佳化問題上,以求得各問題之最佳解為目標。
模擬退火法(Simulated Annealing):
模擬退火法最早由N.Metropolis 等人於1953 年提出,當時並沒有受到研究者的重視。一直到了1983 年由S.Kirkpatrick 等人利用他來求解組合最佳化的問題,才使得此演算法受到人們的重視而得以發揚光大。
模擬退火法的基本觀念主要來自於固體加熱至一定的溫度後會由固體結構瓦解變為液體結構,再對其降溫過程加以控制,使得分子在變回固體結構時,能重新排列成我們所預期的穩定狀態。它結合了最陡坡降法與隨機過程的方式來求得整體最小值。
禁忌搜尋演算法 (Tabu search algorithm):
禁忌搜尋演算法為Glover於1986所提出來具有記憶之最佳化演算法,而由於其具有記憶之前所搜尋路徑的能力,因此可以避免陷入區域解、重覆找尋之前已搜尋過的近似最佳解,目前已被廣泛地應用於許多工程或管理領域問題,如組合最佳化問題、投資組合問題等等。
禁忌搜尋法包含了5個基本元素,分別為起始解、停止條件、禁忌名單、禁忌移動及凌駕條件。禁忌搜尋法的步驟大致如下:
      (1) 找出任一起始解,令此起始解為目前解。
      (2) 自目前解的鄰域中找出一最佳相鄰解。
      (3) 檢查由目前解到最佳相鄰解的移動是否為禁忌移動;若不是禁忌移則動並記錄此移動的目標函數值,且將此移動記錄於禁忌名單中。若為禁忌移動則檢查此移動是否滿足凌駕規則,若滿足凌駕規則則取消此移動之限制狀態並回到步驟2。若無法再移動或是達到停止規則,則 結束搜尋。


參考資料:網路

以下為基因演算法程式僅供參考,如有錯誤請自行Debug
Imports System.Collections.GenericPublic Class GeneticAlgorithm Private Shared Sub Main(args As String())  run(New SqrtChromosome(), 100, 100) End Sub Public Shared Sub run(prototype As Chromosome, size As Integer, maxGen As Integer)  Dim pop As New Population()  pop.initialize(prototype, size)  For genIdx As Integer = 0 To maxGen - 1   pop = pop.reproduction()   Console.WriteLine("================Population {0}================", genIdx)   pop.print()  Next End SubEnd ClassPublic Class Population Inherits List(Of Chromosome) Shared random As New Random(7) Private mutationRate As Double = 0.0 Public Sub initialize(prototype As Chromosome, popSize As Integer)  Me.Clear()  For i As Integer = 0 To popSize - 1   Dim newChrom As Chromosome = prototype.randomInstance()   newChrom.calcFitness()   Me.Add(newChrom)  Next End Sub Public Function selection() As Chromosome  Dim shoot As Integer = random.[Next]((Count * Count) \ 2)  Dim [select] As Integer = CInt(Math.Truncate(Math.Floor(Math.Sqrt(shoot * 2))))  Return DirectCast(Me([select]), Chromosome) End Function Private Shared Function compare(a As Chromosome, b As Chromosome) As Integer  If a.fitness > b.fitness Then   Return 1  ElseIf a.fitness < b.fitness Then   Return -1  Else   Return 0  End If End Function Public Function reproduction() As Population  Me.Sort(AddressOf compare)  Dim newPop As New Population()  For i As Integer = 0 To Count - 1   Dim parent1 As Chromosome = selection()   Dim parent2 As Chromosome = selection()   Dim child As Chromosome = parent1.crossover(parent2)   Dim prob As Double = random.NextDouble()   If prob < mutationRate Then    child.mutate()   End If   child.calcFitness()   newPop.Add(child)  Next  newPop.Sort(AddressOf compare)  Return newPop End Function Public Sub print()  Dim i As Integer = 1  For Each c As Chromosome In Me   Console.WriteLine("{0:##} : {1}", i, c.ToString())   i += 1  Next End SubEnd ClassPublic MustInherit Class Chromosome Public fitness As Double Public MustOverride Function calcFitness() As Double Public MustOverride Function crossover(spouse As Chromosome) As Chromosome Public MustOverride Sub mutate() Public MustOverride Function randomInstance() As ChromosomeEnd ClassPublic Class SqrtChromosome Inherits Chromosome Public Shared random As New Random(7) Public value As String Public k As Double = 2 Public Overrides Function calcFitness() As Double  Dim x As Double = Double.Parse(value)  fitness = -1 * Math.Abs(x * x - k)  Return fitness End Function Public Overrides Function crossover(spouse As Chromosome) As Chromosome  Dim ss As SqrtChromosome = TryCast(spouse, SqrtChromosome)  Dim cutIdx As Integer = random.[Next](value.Length)  Dim head As [String] = value.Substring(0, cutIdx)  Dim tail As [String] = ss.value.Substring(cutIdx)  Dim child As New SqrtChromosome()  child.value = head & tail  Return child End Function Public Overrides Sub mutate()  Dim v As Double = Double.Parse(value)  v += random.NextDouble() - 0.5  value = [String].Format("{0:00.0000}", v) End Sub Public Overrides Function randomInstance() As Chromosome  Dim chrom As New SqrtChromosome()  Dim v As Double = random.NextDouble() * 10  chrom.value = [String].Format("{0:00.0000}", v)  Return chrom End Function Public Overrides Function ToString() As String  Return [String].Format("chromosome={0} fitness={1:F4}", value, fitness) End FunctionEnd Class--------------------------------------------------------------我是分隔線--------------------------------------------------------
Public Class GeneticAlgorithm(Of T)#Region "Properties"    Public ReadOnly Property PopulationSize As Integer        Get            Return _size        End Get    End Property    Public Property CrossoverProbability As Single    Public Property MutationProbability As Single    Public ReadOnly Property Generations As Integer        Get            Return _Generations        End Get    End Property    Public ReadOnly Property Running As Boolean        Get            Return _Running        End Get    End Property#End Region#Region "Private Declarations"    Private Ops As Operators(Of T)    Private _size As Integer    Private Chromosomes As ChromosomeCollection(Of T)    Private _Generations As Integer    Private Context As Threading.SynchronizationContext    Private WorkerThread As Threading.Thread    Private _Running As Boolean#End Region#Region "Constructors"    Private Sub New()    End Sub    Public Sub New(ByVal Ops As Operators(Of T), Optional ByVal PopulationSize As Integer = 30, Optional ByVal CrossoverProbability As Single = 60.0!, Optional ByVal MutationProbability As Single = 1.0!)        _size = PopulationSize        Me.CrossoverProbability = CrossoverProbability        Me.MutationProbability = MutationProbability        Me.Ops = Ops        Me.Chromosomes = New ChromosomeCollection(Of T)        Context = Threading.SynchronizationContext.Current        If PopulationSize Mod 2 = 1 Then            Throw New ArgumentException("Must be a multiple of 2", "PopulationSize")        End If    End Sub#End Region#Region "Methods"    Public Sub StartFinding()        WorkerThread = New Threading.Thread(New Threading.ThreadStart(AddressOf FindSolution))        WorkerThread.Start()        _Running = True    End Sub    Public Sub StopFinding()        _Running = False    End Sub    Private Sub FindSolution()        Chromosomes.Clear()        For I = 0 To PopulationSize - 1            Chromosomes.Add(Me.Ops.CreateChromosome)        Next        Dim SolutionFound As Boolean = False        While Not SolutionFound And _Running            For Each I As Chromosome(Of T) In Me.Chromosomes                I.Fitness = Me.Ops.CalculateFitness(I)            Next            Dim Result = (From Y In Me.Chromosomes _            Where Y.Fitness = _            (From X In Me.Chromosomes _             Select X.Fitness).Max _         ).FirstOrDefault            If Not Me.Ops.ConditionSatisfied(Result) Then                Me.Chromosomes = GetGeneration()            Else                SolutionFound = True                Context.Post(New Threading.SendOrPostCallback(Sub(i)                                                                  RaiseEvent SolutionFound(Me, DirectCast(i, SolutionFoundEventArgs(Of T)))                                                              End Sub), New SolutionFoundEventArgs(Of T)(Result.Encoding))            End If            System.Threading.Thread.Sleep(10)        End While    End Sub    Private Function GetGeneration() As ChromosomeCollection(Of T)        Dim Chromos As New ChromosomeCollection(Of T)        Chromos.AddRange(Me.Ops.SelectEliet(Me.Chromosomes))        Dim R As New Random        _Generations += 1        If Chromos.Count Mod 2 = 1 Then 'just to Make it even agian.            Chromos.Add(Me.Ops.CreateChromosome)        End If        While Chromos.Count < Me.Chromosomes.Count            Dim Crossover As Single = CSng(R.NextDouble * 100)            Dim Parents As Tuple(Of Chromosome(Of T), Chromosome(Of T)) = Ops.SelectParents(Me.Chromosomes)            Dim C1 As Chromosome(Of T) = Parents.Item1            Dim C2 As Chromosome(Of T) = Parents.Item2            If Crossover <= Me.CrossoverProbability Then                Dim T As Tuple(Of Chromosome(Of T), Chromosome(Of T)) = Me.Ops.Crossover(C1, C2)                C1 = T.Item1                C2 = T.Item2                Dim Mutate As Single = CSng(R.NextDouble() * 100)                If Mutate <= MutationProbability Then                    Dim T2 As Tuple(Of Chromosome(Of T), Chromosome(Of T)) = Me.Ops.Mutate(C1, C2)                    C1 = T2.Item1                    C2 = T2.Item2                End If                Chromos.Add(C1)                Chromos.Add(C2)            Else                Chromos.Add(C1)                Chromos.Add(C2)            End If        End While        Context.Post(New Threading.SendOrPostCallback(Sub(i)                                                          RaiseEvent NewGeneration(Me, DirectCast(i, NewGenerationEventArgs(Of T)))                                                      End Sub), New NewGenerationEventArgs(Of T)(Chromos.ToArray))        Return Chromos    End Function#End Region#Region "Events"    Public Event SolutionFound As EventHandler(Of SolutionFoundEventArgs(Of T))    Public Event NewGeneration As EventHandler(Of NewGenerationEventArgs(Of T))#End RegionEnd ClassPublic Class WeightedRandom(Of T)    Inherits List(Of Pair(Of T))    Private R As Random    Sub New()        R = New Random()    End Sub    Sub New(ByVal Seed As Integer)        R = New Random(Seed)    End Sub    Public Function [Next]() As T        Dim Total As Integer = Aggregate x In Me Into Sum(x.Weight)        Dim Rnd As Integer = R.Next(0, Total)        For I = 0 To Me.Count - 1            If Rnd < Me(I).Weight Then                Return Me(I).Item            End If            Rnd -= Me(I).Weight        Next    End FunctionEnd ClassPublic Class Pair(Of T)    Public Property Weight As Integer    Public Property Item As T    Sub New(ByVal Item As T, ByVal Weight As Integer)        Me.Weight = Weight        Me.Item = Item    End SubEnd ClassPublic Class SolutionFoundEventArgs(Of T)    Inherits System.EventArgs    Private _Solution As T    Public ReadOnly Property Solution As T        Get            Return _Solution        End Get    End Property    Sub New(ByVal nSolution As T)        _Solution = nSolution    End SubEnd ClassPublic Class Chromosome(Of T)    Public Property Encoding As T    Public Property Fitness As Double    Public Sub New(ByVal Encoding As T, ByVal Fitness As Double)        Me.Encoding = Encoding        Me.Fitness = Fitness    End SubEnd ClassPublic Interface Operators(Of T)    Function CalculateFitness(ByVal C As Chromosome(Of T)) As Double    Function Crossover(ByVal C1 As Chromosome(Of T), ByVal c2 As Chromosome(Of T)) As Tuple(Of Chromosome(Of T), Chromosome(Of T))    Function Mutate(ByVal C1 As Chromosome(Of T), ByVal C2 As Chromosome(Of T)) As Tuple(Of Chromosome(Of T), Chromosome(Of T))    Function SelectParents(ByVal Chromosomes As ChromosomeCollection(Of T)) As Tuple(Of Chromosome(Of T), Chromosome(Of T))    Function CreateChromosome() As Chromosome(Of T)    Function SelectEliet(ByVal Chromosomes As ChromosomeCollection(Of T)) As ChromosomeCollection(Of T)    Function ConditionSatisfied(ByVal C As Chromosome(Of T)) As BooleanEnd InterfacePublic Class ChromosomeCollection(Of T)    Inherits List(Of Chromosome(Of T))End ClassPublic Class NewGenerationEventArgs(Of T)    Inherits System.EventArgs    Private _Solution() As Chromosome(Of T)    Public ReadOnly Property Generation As Chromosome(Of T)()        Get            Return _Solution        End Get    End Property    Sub New(ByVal nSolution As Chromosome(Of T)())        _Solution = nSolution    End SubEnd Class  

相關閱讀...

工智慧基因演算法程式實例介紹 Java 坦克机器人系列之一
人工智慧基因演算法程式實例介紹 Java 坦克机器人系列之二
一個簡單的遺傳基因演算法應用(java版)
Genetic algorithm基因演算法程式設計參考
遺傳基因演算法程式設計
基因演算法程式實例參考
人工智慧之基因演算法VB.NET程式設計參考
基因演算法程式設計
返回列表