VB のたまご

作成日: 2016/12/03, 更新日: 2016/12/03


遺伝的アルゴリズムの基礎実装を学ぶ2

2つ目の問題(最小経路探し)

  •  これは”巡回セールスマン問題への応用”という説明の部分です。 まずはインターフェースを定義して、何をしなければいけないのか、やることを洗い出して明確にします。 ※以降では、説明用に部分ソースを載せていますが、最後の方で全体ソースを載せています。

  • IGAable.vb
    
    ' 遺伝的アルゴリズムのメンバー
    Public Interface IGAable
    
        ' 第一世代の生成
        Sub Generate1stGeneration()
    
        ' 評価(各染色体メンバーに対して、適応度点数を付ける)
        Sub Evaluation()
    
        ' 選択(適応度が高いメンバーの選別、と同時に低いメンバーの淘汰)
        Sub Selection()
    
        ' 交叉(両親の優秀な遺伝子を受け継ぐ、次世代メンバーの生成)
        Sub Crossover()
    
        ' 突然変異(一定確率で呼び出される、遺伝子操作)
        Sub Mutation()
    
        ' 現世代の状態を表示
        Sub ShowGeneration()
    
    End Interface
    

  •  ここでは、遺伝的アルゴリズムの手順に沿ったふるまいを定義しています。 これらの各処理をサイクルとして動かすことで、進化を起こすことができるというのだから面白いですよね。

  •  次に遺伝子を扱うデータの構成です。

  • イメージ
  •  もしこの相関関係が間違っていた場合ごめんなさいなんですが、その場合でもこのまま説明を進めていきます。 個体1つにつき、解候補1つに対応します。 個体には、現実問題の解候補{ルート順表現(edcba)}と、遺伝的アルゴリズムで扱えるように変換した解候補{順序順表現(54321)}を両方持たせて、 個体に関する情報として扱いやすくしました。評価するための適応度も含めています。 個体は4つをターゲットとして、集団=1世代分として扱います。

  •  重複しますが今回の問題では、解候補をそのままでは扱えないので、順序順表現に変換してから解の探索を始める必要があります。 また、最適解を得られた後も、ルート順表現に逆変換して解答を出す必要があります。

  •  この変換・逆変換処理について、今回のプログラムでは個体自身でやってもらうことにしました。 個体には、ルート順プロパティ、順序順プロパティを持たせていますが、一方のプロパティに値がセットされたタイミングで、 同時にもう一方のプロパティにも(変換した)値をセットするようにしています。

  •  つまり、変換・逆変換処理を組み込みつつ隠ぺいしていて、遺伝的アルゴリズムの処理では意識しなくても済むようにしています。

第一世代の生成

  •  最初に初期集団を生成します。初期集団はルート順表現で作成します。 ルート順を生成する担当と生成したルート順を集団に登録する担当に、処理を分けています。 多様なルート順を評価したいため、重複したルート順が生成された場合は登録しないように制御しています。

  • ' 第一世代の生成
    Public Sub Generate1stGeneration() Implements IGAable.Generate1stGeneration
    
        Dim index = 0
        While True
    
            ' 4つ作成したら抜ける
            If index = 4 Then
                Exit While
            End If
    
            ' (調整)重複ルートは除外
            Dim route = Me.GenerateRoute()
            Dim b1 = Not Me.population.Exists(Function(x) x.Route = route)
            If b1 Then
                Me.population.Add(New Indivisual With {.Route = route})
                index += 1
            End If
    
        End While
    
    End Sub
    
    Private Function GenerateRoute() As String
    
        ' 高スペックすぎるパソコンでの動作対策、時間をずらしてランダムシードをずらす
        Thread.Sleep(1000)
    
        ' dacbe みたいな感じで、5 つ分の遺伝子の組み合わせを生成、返却
        Dim chromosome = String.Empty
        Dim catalogTable = "abcde".ToCharArray().ToList()
        Dim rnd As New Random()
    
        For i As Integer = 5 To 1 Step -1
            Dim index = rnd.Next(i)
            chromosome &= catalogTable(index)
            catalogTable.RemoveAt(index)
        Next
    
        Return chromosome
    
    End Function
    

評価(各染色体メンバーに対して、適応度点数を付ける)

  •  評価方法は、ルート順を元にした合計距離の大小で判定します。 合計距離は、ルート順の並びに合わせて、2点間距離を足していき算出します。 例えば、ルート順が abcde の場合、ab(100), bc(50), cd(100), de(50) で合計距離は 300 になります。 ここで計算した合計距離を、適応度にセットしていきます。

  • ' 評価(各個体に対して、適応度点数を付ける)
    Public Sub Evaluation() Implements IGAable.Evaluation
    
        Me.population.ForEach(Sub(x) x.Fitness = CalcFitness(x.Route))
    
    End Sub
    
    Private Function CalcFitness(route As String) As Integer
    
        ' abcde の場合、ab 間の距離、bc, cd, de と足していく
    
        Dim item = 0
    
        For i As Integer = 1 To route.Length - 1
            Dim key = route(i - 1) & route(i)
            item += Me.distanceDic(key)
        Next
    
        Return item
    
    End Function
    

選択(適応度が高いメンバーの選別、と同時に低いメンバーの淘汰)

  •  選択方法は、評価処理でセットした適応度(合計距離)を元に判断します。 この問題では、適応度が小さいほど最適なルート順となるので、集団の中から最短のもの上位3つを取り出します。 次フェーズの交差処理をするための準備として、集団には先程取り出した3つのみに入れ替えます。

  • ' 選択(適応度が高いメンバーの選別、と同時に低いメンバーの淘汰)
    Public Sub Selection() Implements IGAable.Selection
    
        ' 適応度の昇順でソートして、上位 3 件分のみ取得
        Dim parents = Me.population.OrderBy(Function(x) x.Fitness).Take(3).ToList()
    
        ' 優秀なメンバーのみ残す
        Me.population.Clear()
        Me.population.AddRange(parents)
    
    End Sub
    

交叉(両親の優秀な遺伝子を受け継ぐ、次世代メンバーの生成)

  •  交叉は進化のメイン部分です。ここでは、両親の遺伝子をそれぞれ一部入れ替えて、子供を生成しています。 子供の生成が終わったら世代交代です。集団に入っている親世代を子世代と入れ替えます。

  • ' 交叉(両親の優秀な遺伝子を受け継ぐ、次世代メンバーの生成)
    Public Sub Crossover() Implements IGAable.Crossover
    
        ' 現世代を前世代としてバックアップ
        Me.previousPopulation.Clear()
        Me.previousPopulation.AddRange(Me.population.ToList())
    
        ' メンバー数が 3 と固定されている前提なので、変数に分けて扱う
        Dim parent1 = Me.population(0).Chromosome
        Dim parent2 = Me.population(1).Chromosome
        Dim parent3 = Me.population(2).Chromosome
    
        ' 個体1と個体2、個体1と個体3を交叉
        Dim childA1 = parent1.Substring(0, 2) & parent2.Substring(2)
        Dim childA2 = parent2.Substring(0, 2) & parent1.Substring(2)
    
        Dim childB1 = parent1.Substring(0, 2) & parent3.Substring(2)
        Dim childB2 = parent3.Substring(0, 2) & parent1.Substring(2)
    
        ' 現世代から次世代へ世代交代
        Me.population.Clear()
        Me.population.Add(New Indivisual With {.Chromosome = childA1})
        Me.population.Add(New Indivisual With {.Chromosome = childA2})
        Me.population.Add(New Indivisual With {.Chromosome = childB1})
        Me.population.Add(New Indivisual With {.Chromosome = childB2})
    
    End Sub
    

突然変異(一定確率で呼び出される、遺伝子操作)

  •  当初は、突然変異処理を組み込んでいましたが、うまく調整的動作をさせることができませんでしたので、突然変異は起こさないように変更しました。 その代わりとして、メイン処理側で進化テストを1回の実施ではなく5回の実施に増加して、ばらつきと平均ラインを見極めるように検証路線を変更しました。

  • ' 突然変異(一定確率で呼び出される、遺伝子操作)
    Public Sub Mutation() Implements IGAable.Mutation
    
    End Sub
    

現世代の状態を表示

  •  現在扱っている個体の適応度をコンソール表示します。 ルート順の表示処理が長くて微妙になってしまいましたが、ここでは abcde を a→b→c→d→e という文字列に変換してから表示しています。

  • ' 現世代の状態を表示
    Public Sub ShowGeneration() Implements IGAable.ShowGeneration
    
        Console.WriteLine("")
    
        Dim items = Me.population.Select(Function(x, i) New With {.Index = i, .Data = x}).ToList()
        items.ForEach(Sub(x)
                          Console.WriteLine("個体{0} : ルート({1}), 染色体({2}), 適応度({3})",
                                            x.Index + 1,
                                            String.Join("→", x.Data.Route.ToCharArray().Select(Function(c) c & "").ToArray()),
                                            x.Data.Chromosome,
                                            x.Data.Fitness)
                      End Sub)
    
        Console.WriteLine("--------------------------------------------------------------------")
        Dim avg = items.Average(Function(x) x.Data.Fitness)
        Dim min = items.Min(Function(x) x.Data.Fitness)
        Console.WriteLine("平均適応度 : {0}, 最小適応度 : {1}", avg, min)
    
        Console.WriteLine("")
    
    End Sub
    

実験結果と評価

  •  これらを組み込んだプログラムを実行して動作確認しました。以下はメインプログラムと表示結果です。 二重ループになっていて、第1世代から第10世代までの進化テストを、5回おこないます。

  • Module1.vb
    
    Sub Main()
    
        ' 進化テストを5回おこなう
        For i As Integer = 1 To 5
    
            ' 第一世代を生成
            Dim worker As New GAWorker()
            worker.Generate1stGeneration()
    
            ' 第10世代まで進化させる
            For k As Integer = 1 To 10
    
                ' 現世代を評価
                worker.Evaluation()
    
                ' 現世代の状況表示
                worker.ShowGeneration()
    
                ' 選択
                worker.Selection()
    
                ' 交叉
                worker.Crossover()
    
                ' 突然変異
                worker.Mutation()
    
            Next
    
        Next
    
        ' 画面を閉じない
        Console.ReadLine()
    End Sub
    

  •  ある1回分の進化テストにおける、第1世代から第10世代までの進化過程

  • 個体1 : ルート(a→d→b→c→e), 染色体(13111), 適応度(350)
    個体2 : ルート(d→a→b→e→c), 染色体(41121), 適応度(450)
    個体3 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体4 : ルート(c→e→a→d→b), 染色体(34121), 適応度(375)
    --------------------------------------------------------------------
    平均適応度 : 368.75, 最小適応度 : 300
    
    
    個体1 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体2 : ルート(a→d→b→c→e), 染色体(13111), 適応度(350)
    個体3 : ルート(a→c→b→e→d), 染色体(12121), 適応度(350)
    個体4 : ルート(c→e→a→b→d), 染色体(34111), 適応度(375)
    --------------------------------------------------------------------
    平均適応度 : 343.75, 最小適応度 : 300
    
    
    個体1 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体2 : ルート(a→d→b→c→e), 染色体(13111), 適応度(350)
    個体3 : ルート(a→c→b→e→d), 染色体(12121), 適応度(350)
    個体4 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    --------------------------------------------------------------------
    平均適応度 : 325, 最小適応度 : 300
    
    
    個体1 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体2 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体3 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体4 : ルート(a→d→b→c→e), 染色体(13111), 適応度(350)
    --------------------------------------------------------------------
    平均適応度 : 312.5, 最小適応度 : 300
    
    
    個体1 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体2 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体3 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体4 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    --------------------------------------------------------------------
    平均適応度 : 300, 最小適応度 : 300
    
    
    個体1 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体2 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体3 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体4 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    --------------------------------------------------------------------
    平均適応度 : 300, 最小適応度 : 300
    
    
    個体1 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体2 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体3 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体4 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    --------------------------------------------------------------------
    平均適応度 : 300, 最小適応度 : 300
    
    
    個体1 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体2 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体3 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体4 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    --------------------------------------------------------------------
    平均適応度 : 300, 最小適応度 : 300
    
    
    個体1 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体2 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体3 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体4 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    --------------------------------------------------------------------
    平均適応度 : 300, 最小適応度 : 300
    
    
    個体1 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体2 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体3 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    個体4 : ルート(a→c→b→d→e), 染色体(12111), 適応度(300)
    --------------------------------------------------------------------
    平均適応度 : 300, 最小適応度 : 300
    

  •  このままでも見れなくはないですが、別途グラフを作成しましたので、こちらを見ながら評価をしたいと思います。 グラフは OxyPlot を使って作成しました。

  • イメージ
    イメージ
  •  平均適応度の推移グラフを見ると、右肩下がりなのは良いのですが、ちょっと下がると安定してしまって、進化が止まってしまう傾向にあるみたいです。 また、最小適応度の推移グラフを見ると、第一世代から不動で世代交代がおこなわれています。

  •  両方とも、基準ラインから同じように進んでいって途中で終わってしまっています。 つまり、第一世代の出来次第で(世代交代による進化に関係なく)最後まで決まってしまう的な感じなので、 進化の部分をもう少し改良する必要があるのかなと、見ていて思いました。

  •  理想的なのは、第一世代のスタート位置(優劣状態)に関係なく、世代交代するたびに右肩下がりに進んでいき、最終的には同じ適応度に収束するような、 折れ線が重なり合うような終わり方にしたいですね。

  •  最後まで読んでいただきありがとうございました。

全体のプログラム

    Indivisual.vb
    
    ' 1つの個体情報
    Public Class Indivisual
    
        ' 表現型、ルート順
        Private _Route As String = String.Empty
        Public Property Route As String
            Get
                Return _Route
            End Get
            Set(value As String)
                _Route = value
                _Chromosome = Me.ConvertToChromosome()
            End Set
        End Property
    
        ' 遺伝子型、染色体
        ' ターゲットにしている問題に対する、答え候補の1つ
        ' ※手抜き管理。本当は Byte(4) とかで厳格に管理するべき
        'Public Property Chromosome As Byte() = New Byte(4) {0, 0, 0, 0, 0}
        Private _Chromosome As String = String.Empty
        Public Property Chromosome As String
            Get
                Return _Chromosome
            End Get
            Set(value As String)
                _Chromosome = value
                _Route = Me.ConvertToRoute()
            End Set
        End Property
    
        ' 適応度
        ' ターゲットにしている問題に対する答えとして、どのくらい最適解になっているかの指標
        Public Property Fitness As Integer = 99999
    
    
    
        ' コンストラクタ
        Public Sub New()
        End Sub
    
        ' 表現型から遺伝子型への変換
        Private Function ConvertToChromosome() As String
    
            ' abcde を基準に考える
            ' 最初が a なら 1 番目なので 変換後の 1つ目は 1。
    
            ' a を取り除いて、bcde を基準に考える
            ' 次が d なら 3 番目なので、変換後の 2つ目は3。
            ' ...
    
            Dim catalogTable = "abcde".ToCharArray().ToList()
            Dim item = String.Empty
    
            For Each c As Char In Me._Route
                item &= CType(catalogTable.IndexOf(c) + 1, String)
                catalogTable.Remove(c)
            Next
    
            Return item
    
        End Function
    
        ' 遺伝子型から表現型への変換
        Private Function ConvertToRoute() As String
    
            ' 54321 → edcba に変換したい
            ' abcde を基準に考える
    
            Dim catalogTable = "abcde".ToCharArray().ToList()
            Dim item = String.Empty
    
            For Each c As Char In Me._Chromosome
                Dim index = CType(c.ToString(), Integer) - 1
                item &= catalogTable(index)
                catalogTable.RemoveAt(index)
            Next
    
            Return item
    
        End Function
    
    End Class
    

    IGAable.vb
    
    ' 遺伝的アルゴリズムのメンバー
    Public Interface IGAable
    
        ' 第一世代の生成
        Sub Generate1stGeneration()
    
        ' 評価(各染色体メンバーに対して、適応度点数を付ける)
        Sub Evaluation()
    
        ' 選択(適応度が高いメンバーの選別、と同時に低いメンバーの淘汰)
        Sub Selection()
    
        ' 交叉(両親の優秀な遺伝子を受け継ぐ、次世代メンバーの生成)
        Sub Crossover()
    
        ' 突然変異(一定確率で呼び出される、遺伝子操作)
        Sub Mutation()
    
        ' 現世代の状態を表示
        Sub ShowGeneration()
    
    End Interface
    

    GAWorker.vb
    
    Imports System.Threading
    Imports System.Text
    Imports System.IO
    
    
    ' 遺伝子の管理を担当するクラスです。
    Public Class GAWorker
        Implements IGAable
    
        ' 巡回セールスマン問題の最適解を求める
    
        ' ---------------------------------------------------------------------------------------------
        ' (質問)abcde, eacdb, ... とかいろいろルート順があるけど、どれが最短経路ですか?
        ' ↓
        ' 表現型候補を遺伝子型候補に変換して、進化進化・・・
        ' ↓
        ' 見つけた!じゃあ、遺伝子型から表現型に戻す
        ' ↓
        ' (解答)どうやら、cbade が最短経路ですね。みたいな流れ
        ' ---------------------------------------------------------------------------------------------
    
        ' 元々の解候補(表現型、abcde)→ 遺伝的アルゴリズムで扱える形式(遺伝子型、13211)への変換処理と、
        ' 遺伝的アルゴリズムで扱える形式(遺伝子型、13211)→ 元々の解候補(表現型、abcde)への逆変換処理を考える必要がある
        ' ※上記記載中の表現型や遺伝子型は考え方として書いているのであり、実際値としての正誤は分かりません。
    
        ' ※遺伝子型と言っていますが、値は、01101 のような遺伝子羅列ではなく、番号順 54321 のように、1~5 で管理します。 
        ' 番号順とは、【abcde の順番で回るルート順を基準として】考えた時に、
        ' abcde の順番で回る場合は、11111、
        ' edcba の順番で回る場合は、54321、
        ' cdeab の順番で回る場合は、33311、と変換できる番号順の事です。
    
        ' edcba を例に変換してみると、
        ' 最初の e は、abcde で考えると 5 番目にあるので、
        ' 変換後の最初の番号は、5 となります(e はもう出てこないので、abcd に削ります)。
    
        ' 2番目の d は、abcd で考えると 4 番目にあるので、
        ' 変換後の次の番号は、4 となります(d はもう出てこないので、abc に削ります)。
    
        ' 3番目の c は、abc で考えると 3 番目にあるので、
        ' 変換後の次の番号は、3 となります(c はもう出てこないので、ab に削ります)。
    
        ' 4番目の b は、ab で考えると 2 番目にあるので、
        ' 変換後の次の番号は、2 となります(b はもう出てこないので、a に削ります)。
    
        ' 最後の a は、a で考えると 1 番目にあるので、
        ' 変換後の最後の番号は、1 となります(a を削ると残りは無いので終わりです)。
    
    
    
        ' 変換・逆変換処理が追加されたのと、評価関数の判定方法が、大きい方ではなく小さい方が優秀ということ以外は、
        ' 前回と同様
    
    
    
        ' 集団 (population) : List(Of Individual)
        ' 個体 (Indivisual) : Class
        '   表現型、ルート順 (Route) : String, 町名順 候補 / 1 char : 町名 (town), 訪れる町1つ分
        '   遺伝子型、染色体 (Chromosome) : String, 順番 候補 / 1 char : 遺伝子 (gene), 訪れる順番1つ分
        '   適応度 (Fitness) : Integer, 全ての町を回った際の合計距離
    
        ' 表現型と遺伝子型の相互変換処理について
        ' 表現型プロパティと遺伝子型プロパティを準備しているが、一方のプロパティのセット時に、
        ' 相手方へも変換して自動セットしてあげる機構にすれば、気にしなくてよくなる
    
    
        ' 集団
        Private Property population As List(Of Indivisual) = Nothing
    
        ' 前世代集団
        Private Property previousPopulation As List(Of Indivisual) = Nothing
    
        ' 各町間の距離テーブル
        Private Property distanceDic As Dictionary(Of String, Integer) = Nothing
    
        ' コンストラクタ
        Public Sub New()
    
            Me.population = New List(Of Indivisual)
            Me.previousPopulation = New List(Of Indivisual)
    
            Me.distanceDic = New Dictionary(Of String, Integer)
            Me.distanceDic("ab") = 100
            Me.distanceDic("ac") = 125
            Me.distanceDic("ad") = 100
            Me.distanceDic("ae") = 75
    
            Me.distanceDic("ba") = 100
            Me.distanceDic("bc") = 50
            Me.distanceDic("bd") = 75
            Me.distanceDic("be") = 125
    
            Me.distanceDic("ca") = 125
            Me.distanceDic("cb") = 50
            Me.distanceDic("cd") = 100
            Me.distanceDic("ce") = 125
    
            Me.distanceDic("da") = 100
            Me.distanceDic("db") = 75
            Me.distanceDic("dc") = 100
            Me.distanceDic("de") = 50
    
            Me.distanceDic("ea") = 75
            Me.distanceDic("eb") = 125
            Me.distanceDic("ec") = 125
            Me.distanceDic("ed") = 50
    
        End Sub
    
        ' 第一世代の生成
        Public Sub Generate1stGeneration() Implements IGAable.Generate1stGeneration
    
            Dim index = 0
            While True
    
                ' 4つ作成したら抜ける
                If index = 4 Then
                    Exit While
                End If
    
                ' (調整)重複ルートは除外
                Dim route = Me.GenerateRoute()
                Dim b1 = Not Me.population.Exists(Function(x) x.Route = route)
                If b1 Then
                    Me.population.Add(New Indivisual With {.Route = route})
                    index += 1
                End If
    
            End While
    
        End Sub
    
        Private Function GenerateRoute() As String
    
            ' 高スペックすぎるパソコンでの動作対策、時間をずらしてランダムシードをずらす
            Thread.Sleep(1000)
    
            ' dacbe みたいな感じで、5 つ分の遺伝子の組み合わせを生成、返却
            Dim chromosome = String.Empty
            Dim catalogTable = "abcde".ToCharArray().ToList()
            Dim rnd As New Random()
    
            For i As Integer = 5 To 1 Step -1
                Dim index = rnd.Next(i)
                chromosome &= catalogTable(index)
                catalogTable.RemoveAt(index)
            Next
    
            Return chromosome
    
        End Function
    
        ' 評価(各個体に対して、適応度点数を付ける)
        Public Sub Evaluation() Implements IGAable.Evaluation
    
            Me.population.ForEach(Sub(x) x.Fitness = CalcFitness(x.Route))
    
        End Sub
    
        Private Function CalcFitness(route As String) As Integer
    
            ' abcde の場合、ab 間の距離、bc, cd, de と足していく
    
            Dim item = 0
    
            For i As Integer = 1 To route.Length - 1
                Dim key = route(i - 1) & route(i)
                item += Me.distanceDic(key)
            Next
    
            Return item
    
        End Function
    
        ' 選択(適応度が高いメンバーの選別、と同時に低いメンバーの淘汰)
        Public Sub Selection() Implements IGAable.Selection
    
            ' 適応度の昇順でソートして、上位 3 件分のみ取得
            Dim parents = Me.population.OrderBy(Function(x) x.Fitness).Take(3).ToList()
    
            ' 優秀なメンバーのみ残す
            Me.population.Clear()
            Me.population.AddRange(parents)
    
        End Sub
    
        ' 交叉(両親の優秀な遺伝子を受け継ぐ、次世代メンバーの生成)
        Public Sub Crossover() Implements IGAable.Crossover
    
            ' 現世代を前世代としてバックアップ
            Me.previousPopulation.Clear()
            Me.previousPopulation.AddRange(Me.population.ToList())
    
            ' メンバー数が 3 と固定されている前提なので、変数に分けて扱う
            Dim parent1 = Me.population(0).Chromosome
            Dim parent2 = Me.population(1).Chromosome
            Dim parent3 = Me.population(2).Chromosome
    
            ' 個体1と個体2、個体1と個体3を交叉
            Dim childA1 = parent1.Substring(0, 2) & parent2.Substring(2)
            Dim childA2 = parent2.Substring(0, 2) & parent1.Substring(2)
    
            Dim childB1 = parent1.Substring(0, 2) & parent3.Substring(2)
            Dim childB2 = parent3.Substring(0, 2) & parent1.Substring(2)
    
            ' 現世代から次世代へ世代交代
            Me.population.Clear()
            Me.population.Add(New Indivisual With {.Chromosome = childA1})
            Me.population.Add(New Indivisual With {.Chromosome = childA2})
            Me.population.Add(New Indivisual With {.Chromosome = childB1})
            Me.population.Add(New Indivisual With {.Chromosome = childB2})
    
        End Sub
    
        ' 突然変異(一定確率で呼び出される、遺伝子操作)
        Public Sub Mutation() Implements IGAable.Mutation
    
        End Sub
    
        ' 現世代の状態を表示
        Public Sub ShowGeneration() Implements IGAable.ShowGeneration
    
            Console.WriteLine("")
    
            Dim items = Me.population.Select(Function(x, i) New With {.Index = i, .Data = x}).ToList()
            items.ForEach(Sub(x)
                              Console.WriteLine("個体{0} : ルート({1}), 染色体({2}), 適応度({3})",
                                                x.Index + 1,
                                                String.Join("→", x.Data.Route.ToCharArray().Select(Function(c) c & "").ToArray()),
                                                x.Data.Chromosome,
                                                x.Data.Fitness)
                          End Sub)
    
            Console.WriteLine("--------------------------------------------------------------------")
            Dim avg = items.Average(Function(x) x.Data.Fitness)
            Dim min = items.Min(Function(x) x.Data.Fitness)
            Console.WriteLine("平均適応度 : {0}, 最小適応度 : {1}", avg, min)
    
            Console.WriteLine("")
    
        End Sub
    
        ' 分析用 csv ファイルを出力
        Public Sub OutputGeneration(csvFile As String)
    
            Dim number = 0
            Dim avg = Me.population.Average(Function(x) x.Fitness)
            Dim min = Me.population.Min(Function(x) x.Fitness)
    
            If File.Exists(csvFile) Then
    
                ' ファイルが存在する場合、最終行データから前世代番号を取得して、現世代番号をセット
                Dim csvDatas = File.ReadAllLines(csvFile).Reverse()
                For Each csvData In csvDatas
    
                    Dim items = csvData.Split(","c)
                    If Not IsNumeric(items(0)) Then
                        Continue For
                    End If
    
                    number = CType(items(0), Integer)
                    number += 1
                    Exit For
    
                Next
    
                Dim wData = String.Format("{0},{1},{2}" & vbNewLine, number, avg, min)
                File.AppendAllText(csvFile, wData)
    
            Else
    
                number = 1
                Dim wData = String.Format("{0},{1},{2}" & vbNewLine, "GenerationNumber", "Average", "Min")
                File.WriteAllText(csvFile, wData)
    
                wData = String.Format("{0},{1},{2}" & vbNewLine, number, avg, min)
                File.AppendAllText(csvFile, wData)
    
            End If
    
        End Sub
    
    End Class
    

    Module1.vb
    
    Module Module1
    
        Sub Main()
    
            ' 進化テストを5回おこなう
            For i As Integer = 1 To 5
    
                ' 第一世代を生成
                Dim worker As New GAWorker()
                worker.Generate1stGeneration()
    
                ' 第10世代まで進化させる
                Dim csvFile = "result_" & Guid.NewGuid.ToString() & ".csv"
                For k As Integer = 1 To 10
    
                    ' 現世代を評価
                    worker.Evaluation()
    
                    ' 現世代の状況表示
                    worker.ShowGeneration()
                    ' 分析用 csv ファイルを出力
                    worker.OutputGeneration(csvFile)
    
                    ' 選択
                    worker.Selection()
    
                    ' 交叉
                    worker.Crossover()
    
                    ' 突然変異
                    worker.Mutation()
    
                Next
    
            Next
    
            ' 画面を閉じない
            Console.ReadLine()
        End Sub
    
    End Module