Algoritma EO (Evolutionary Optimization)

Algoritma EO (Evolutionary Optimization) adalah salah satu algoritma optimasi yang dapat digunakan untuk pengambilan keputusan. Contoh yang dibahas kali ini adalah mengenai pencarian posisi dengan pengembalian nilai fungsi minimal.
Evolutionary Optimization adalah algoritma yang menggunakan mekanisme seleksi biologi, seperti seleksi, reproduksi, rekombinasi dan mutasi. Calon solusi permasalahan diibaratkan sebagai individu dalam sebuah populasi, dan nilai fitness akan menentukan seberapa baik individu tersebut dapat bertahan.
Algoritma ini merupakan salah satu variasi dari Algoritma GA (Genetic Algorithm) / Genetika Algoritma, oleh karena itu memiliki struktur yang sama seperti perhitungan fitness, crossover dan mutasi. Implementasi algoritma ini dapat pula diterapkan untuk pencarian matriks bobot dalam algoritma berbasis jaringan.

Diasumsikan ada sebaran titik 3 dimensi, yaitu dimensi x, y, z
Masing-masing dimensi memiliki sebuah konstanta dan batas rentang titik yang dapat digunakan
Contoh data pada masing-masing dimensi adalah sebagai berikut

Contoh data awal adalah sebagai berikut:

Dim data(2)() As Double
data(0) = New Double() {3.2, 10, 50}
data(1) = New Double() {3, 30, 80}
data(2) = New Double() {2.5, 50, 150}

Nilai fungsi yang diketahui adalah dengan rumus f(x, y, z) = (kx * x^2) + (ky * y^2) + (kz * z^2)
Tentukan posisi dimana fungsi tersebut mengembalikan nilai minimal
Dengan batasan nilai bahwa x + y + z harus bernilai 210

Sebelum masuk kedalam langkah-langkah pembahasan algoritma, ada beberapa konstanta atau parameter yang harus diketahui, yaitu:
* Tentukan dimensi permasalahan (jumlah gen) dalam sebuah solusi (kromosom)
Diasumsikan dalam kasus ini, dimensi bernilai 3 karena ada 3 dimensi yang akan dicari solusinya

Const dimensi As Integer = 3

* Tentukan popsize / ukuran populasi
nilai yang direkomendasikan adalah 10 sampai dengan 1000
Diasumsikan dalam kasus ini, ukuran popsize adalah 20

Const popSize As Integer = 20

* Tentukan probabilitas mutasi, yaitu besar kemungkinan sebuah gen akan bermutasi
nilai yang direkomendasikan adalah 0.1 sampai dengan 0.5
Diasumsikan dalam kasus ini, probabilitas mutasi adalah 0.2

Const probabilitasMutasi As Double = 0.2

* Tentukan konstanta pergerakan gen pada saat bermutasi
semakin besar nilai ini, maka semakin luas area perpindahan gen pada saat bermutasi
nilai yang direkomendasikan adalah 0.001 sampai dengan 0.1
Diasumsikan dalam kasus ini, konstanta pergerakan gen adalah 0.01

Const luasPergerakanMutasi As Double = 0.01

* Tentukan tau, yaitu persentase jumlah kromosom induk yang terpilih untuk kemudian dicari induk terbaiknya
nilai yang direkomendasikan adalah 0.3 sampai dengan 0.7
Diasumsikan dalam kasus ini, tau bernilai 0.4

Const tau As Double = 0.4

* Tentukan jumlah maksimal iterasi / generasi yang dilakukan
Diasumsikan dalam kasus ini, jumlah maksimal iterasi adalah 1000

Const maksGenerasi As Integer = 1000

* Tentukan batas nilai fungsi yang paling rendah
Jika nilai fungsi yang ditemukan sudah kurang dari nilai ini, maka perhitungan sudah selesai
Diasumsikan dalam kasus ini, batas nilai fungsi yang paling rendah adalah 0.00001

Const batasNilaiFungsiMinimal As Double = 0.00001

* Tentukan total posisi yang harus dicapai
Semua solusi yang ditemukan oleh masing-masing individu harus berjumlah sebanyak variabel ini
Diasumsikan dalam kasus ini, total nilai yang harus dicapai adalah 210

Const totalPosisi As Integer = 210

Langkah-langkah penggunaan algoritma ini adalah

* Lakukan proses pencarian posisi terbaik sebanyak jumlah perulangan
Penjelasan lebih detail tentang fungsi ini dapat dilihat pada penjelasan skrip dibawah ini (poin 1 – 3)

Dim solusiTerbaik As Integer() = prosesPerhitungan(dimensi, popSize, probabilitasMutasi, luasPergerakanMutasi, tau, maksGenerasi, batasNilaiFungsiMinimal, totalPosisi, data)

Memasuki fungsi prosesPerhitungan untuk melakukan pencarian posisi terbaik

1. Inisialisasi individu sebanyak parameter popsize, dan inisialisasi posisi nya sebanyak parameter dimensi
Untuk setiap individu, Beri nilai kromosom acak pada setiap dimensi
Kemudian hitung nilai fungsi untuk individu pada posisi tersebut

populasi(i) = New Individu(dimensi, probabilitasMutasi, luasPergerakanMutasi, totalPosisi, data)

2. Untuk masing-masing individu awal, lakukan pengecekan apakah individu ini berada pada posisi terbaik

If populasi(i).nilaiFungsi < nilaiFungsiTerbaik Then
	nilaiFungsiTerbaik = populasi(i).nilaiFungsi
	Array.Copy(populasi(i).kromosom, solusiTerbaik, dimensi)

	indeksPosisiTerbaik = i
End If

3. Lakukan proses pencarian posisi terbaik sebanyak jumlah perulangan (poin 3a – 3e)

Dim generasi As Integer = 0
Dim selesai As Boolean = False
While generasi < maksGenerasi AndAlso selesai = False
. . .

3a. Tentukan 2 data induk pada populasi, yang kira-kira memiliki nilai fungsi yang cukup rendah

3a1. Lakukan pengacakan urutan indeks populasi, sehingga populasi yang dipilih tidak akan berurutan

For i As Integer = 0 To indeksPopulasi.Length - 1
	Dim r As Integer = rnd.Next(i, indeksPopulasi.Length)
	Dim tmp As Integer = indeksPopulasi(r)
	indeksPopulasi(r) = indeksPopulasi(i)
	indeksPopulasi(i) = tmp
Next

3a2. Tentukan banyak calon induk yang akan dipilih
Kemudian ambil induk acak sebanyak jumlah calon induk
Urutkan calon induk acak, kemudian ambil 2 data teratas untuk menjadi jawaban 2 data induk yang dicari

Dim ukuranCalonIndukTerpilih As Integer = CInt(tau * popSize)
If ukuranCalonIndukTerpilih < n Then
	ukuranCalonIndukTerpilih = n
End If
Dim calonIndukTerpilih As Individu() = New Individu(ukuranCalonIndukTerpilih - 1) {}

For i As Integer = 0 To ukuranCalonIndukTerpilih - 1
	calonIndukTerpilih(i) = populasi(indeksPopulasi(i))
Next
Array.Sort(calonIndukTerpilih)

Dim induk As Individu() = New Individu(n - 1) {}
For i As Integer = 0 To n - 1
	induk(i) = calonIndukTerpilih(i)
Next

3b. Buat 2 data anak dari 2 data induk yang sudah dipilih sebelumnya

3b1. Lakukan proses crossover
Buat 2 individu anak yang baru
Masukan sebagian kromosom induk 1 dan sebagian kromosom induk 2 kepada anak 1
Masukan sebagian kromosom induk 2 dan sebagian kromosom induk 1 kepada anak 2

Dim jumlahGen As Integer = induk(0).kromosom.Length
Dim anak1 As New Individu(jumlahGen, probabilitasMutasi, luasPergerakanMutasi, totalPosisi, data)
Dim anak2 As New Individu(jumlahGen, probabilitasMutasi, luasPergerakanMutasi, totalPosisi, data)

Dim crossover As Integer = rnd.Next(0, jumlahGen - 1)
For i As Integer = 0 To crossover
	anak1.kromosom(i) = induk(0).kromosom(i)
Next
For i As Integer = crossover + 1 To jumlahGen - 1
	anak2.kromosom(i) = induk(0).kromosom(i)
Next
For i As Integer = 0 To crossover
	anak2.kromosom(i) = induk(1).kromosom(i)
Next
For i As Integer = crossover + 1 To jumlahGen - 1
	anak1.kromosom(i) = induk(1).kromosom(i)
Next

3b2. Lakukan proses mutasi
Pada masing-masing kromosom anak1
Apabila termasuk dalam probabilitas mutasi, maka lakukan proses mutasi pada kromosom tersebut
Yaitu dengan menambahkan nilai acak pada kromosom tersebut

For i As Integer = 0 To anak1.kromosom.Length - 1
	If rnd.NextDouble() < probabilitasMutasi Then
		Dim hi As Double = luasPergerakanMutasi * data(i)(2)
		Dim lo As Double = -hi

		Dim delta As Double = (hi - lo) * rnd.NextDouble() + lo
		anak1.kromosom(i) += delta
		
		. . .

3b3. Perlu diingat bahwa apabila nilai posisi baru melebihi batas nilai minimal dan maksimal pada masing-masing dimensi,
maka kembalikan nilai posisi nya agar kembali dalam rentang nilai pada dimensi tersebut

If anak1.kromosom(i) < data(i)(1) Then
	anak1.kromosom(i) = data(i)(1)
ElseIf anak1.kromosom(i) > data(i)(2) Then
	anak1.kromosom(i) = data(i)(2)
End If

3b4. Sama seperti perhitungan sebelumnya, jumlah posisi diatas belum tentu sesuai dengan parameter totalPosisi
Oleh karena itu, lakukan penyesuaian posisi agar jumlah posisi selalu bernilai sama dengan parameter totalPosisi

Dim jumlahPosisi As Integer = 0
For k As Integer = 0 To dimensi - 1
	jumlahPosisi += anak1.kromosom(k)
Next

Do While jumlahPosisi <> totalPosisi
	Dim selisih As Integer = totalPosisi - jumlahPosisi
	Dim selisihPerDimensi(dimensi - 1) As Integer
	Dim idx As Integer = -1
	Do While selisih <> 0
		idx = rnd.Next(dimensi)
		If selisih > 0 Then
			If anak1.kromosom(idx) + selisihPerDimensi(idx) < data(idx)(2) Then
				selisihPerDimensi(idx) += 1
				selisih -= 1
			End If
		Else
			If anak1.kromosom(idx) + selisihPerDimensi(idx) > data(idx)(1) Then
				selisihPerDimensi(idx) -= 1
				selisih += 1
			End If
		End If
	Loop
	For k As Integer = 0 To dimensi - 1
		Dim posisiBaru As Integer = anak1.kromosom(k) + selisihPerDimensi(k)
		If posisiBaru < data(k)(1) Then Continue Do
		If posisiBaru > data(k)(2) Then Continue Do
	Next
	For k As Integer = 0 To dimensi - 1
		Dim posisiBaru As Integer = anak1.kromosom(k) + selisihPerDimensi(k)
		jumlahPosisi = jumlahPosisi - anak1.kromosom(k) + posisiBaru
		anak1.kromosom(k) = posisiBaru
	Next
Loop

3b5. Lakukan proses mutasi yang sama (poin 3b2 – 3b4) untuk individu anak 2

For i As Integer = 0 To anak2.kromosom.Length - 1
	If rnd.NextDouble() < probabilitasMutasi Then
		Dim hi As Double = luasPergerakanMutasi * data(i)(2)
		Dim lo As Double = -hi

		Dim delta As Double = (hi - lo) * rnd.NextDouble() + lo
		anak2.kromosom(i) += delta

		If anak2.kromosom(i) < data(i)(1) Then
			anak2.kromosom(i) = data(i)(1)
		ElseIf anak2.kromosom(i) > data(i)(2) Then
			anak2.kromosom(i) = data(i)(2)
		End If
	End If
Next

jumlahPosisi = 0
For k As Integer = 0 To dimensi - 1
	jumlahPosisi += anak2.kromosom(k)
Next

Do While jumlahPosisi <> totalPosisi
	Dim selisih As Integer = totalPosisi - jumlahPosisi
	Dim selisihPerDimensi(dimensi - 1) As Integer
	Dim idx As Integer = -1
	Do While selisih <> 0
		idx = rnd.Next(dimensi)
		If selisih > 0 Then
			If anak2.kromosom(idx) + selisihPerDimensi(idx) < data(idx)(2) Then
				selisihPerDimensi(idx) += 1
				selisih -= 1
			End If
		Else
			If anak2.kromosom(idx) + selisihPerDimensi(idx) > data(idx)(1) Then
				selisihPerDimensi(idx) -= 1
				selisih += 1
			End If
		End If
	Loop
	For k As Integer = 0 To dimensi - 1
		Dim posisiBaru As Integer = anak2.kromosom(k) + selisihPerDimensi(k)
		If posisiBaru < data(k)(1) Then Continue Do
		If posisiBaru > data(k)(2) Then Continue Do
	Next
	For k As Integer = 0 To dimensi - 1
		Dim posisiBaru As Integer = anak2.kromosom(k) + selisihPerDimensi(k)
		jumlahPosisi = jumlahPosisi - anak2.kromosom(k) + posisiBaru
		anak2.kromosom(k) = posisiBaru
	Next
Loop

3b6. Setelah proses crossover dan mutasi, hitung nilai fungsi pada masing-masing anak
Kemudian masukkan 2 individu anak ini sebagai jawaban individu anak

anak1.nilaiFungsi = hitungNilaiFungsi(anak1.kromosom, data)
anak2.nilaiFungsi = hitungNilaiFungsi(anak2.kromosom, data)

* Gunakan fungsi ini untuk menghitung nilai fungsi individu tersebut
Rumus yang digunakan adalah sesuai dengan rumus yang sudah ditentukan, yaitu
f(x, y, z) = (kx * x^2) + (ky * y^2) + (kz * z^2)

Public Function hitungNilaiFungsi(ByVal kromosom() As Integer, ByVal data()() As Double) As Double
	Dim hasil As Double = 0.0
	For i As Integer = 0 To kromosom.Length - 1
		hasil += data(i)(0) * kromosom(i) * kromosom(i)
	Next i
	Return hasil
End Function

3c. Urutkan populasi induk, kemudian masukkan 2 data anak untuk menggantikan 2 data induk yang paling buruk (nilai fungsi tertinggi)

Array.Sort(populasi)
populasi(popSize - 1) = anak1
populasi(popSize - 2) = anak2

3d. Buat 1 individu acak untuk menggantikan individu induk dengan posisi ketiga terburuk

Dim individuAcak As New Individu(jumlahGen, probabilitasMutasi, luasPergerakanMutasi, totalPosisi, data)
populasi(popSize - 3) = individuAcak

3e. Hitung nilai fungsi pada 3 data yang baru, yaitu 2 data anak dan 1 data individu acak
Jika nilai fungsinya lebih rendah dari nilai fungsi terbaik, ambil individu tersebut sebagai solusi terbaik
Jika nilai fungsinya lebih rendah dari batas minimal nilai fungsi, maka hentikan perhitungan

For i As Integer = popSize - 3 To popSize - 1
	If populasi(i).nilaiFungsi < nilaiFungsiTerbaik Then
		nilaiFungsiTerbaik = populasi(i).nilaiFungsi
		populasi(i).kromosom.CopyTo(solusiTerbaik, 0)

		Console.Write("Generasi = " & generasi.ToString.PadRight(3) & ", " & IIf(i = popSize - 3, "Individu Acak  ", IIf(i = popSize - 2, "Individu Anak 2", IIf(i = popSize - 1, "Individu Anak 1", ""))) & ", ")
		Console.WriteLine("nilai fungsi = " & nilaiFungsiTerbaik.ToString("F2"))

		If nilaiFungsiTerbaik < batasNilaiFungsiMinimal Then
			selesai = True
			Console.WriteLine(vbLf & "Perhitungan dihentikan pada generasi " & generasi)
		End If
	End If
Next

* Agar dapat menjalankan skrip diatas, maka diperlukan sebuah Class Individu untuk menampung semua data kromosom, nilai fungsi, jumlah gen, probabilitas mutasi, dan konstanta pergerakan gen. Deklarasi Class Individu adalah sebagai berikut:

Public Class Individu
    Implements IComparable(Of Individu)

    Public kromosom As Integer()            ' solusi yang dicari
    Public nilaiFungsi As Double            ' semakin rendah, maka semakin baik
    Private jumlahGen As Integer            ' jumlah Gen / dimensi permasalahan
    Private probabilitasMutasi As Double    ' probabilitas gen untuk bermutasi
    Private luasPergerakanMutasi As Double  ' luas area perpindahan gen
    Private Shared rnd As New Random(0)

    Public Sub New(jumlahGen As Integer, probabilitasMutasi As Double, luasPergerakanMutasi As Double, ByVal totalPosisi As Integer, ByVal data()() As Double)
        Me.jumlahGen = jumlahGen
        Me.probabilitasMutasi = probabilitasMutasi
        Me.luasPergerakanMutasi = luasPergerakanMutasi
        Me.kromosom = New Integer(jumlahGen - 1) {}

        Dim jumlahPosisi As Integer = 0
        Do While jumlahPosisi <> totalPosisi
            'Untuk setiap kromosom, Beri nilai posisi acak pada setiap dimensi
            'Setiap dimensi memiliki batas minimal dan maksimal sendiri-sendiri, sesuai pada isian parameter data
            jumlahPosisi = 0
            For i As Integer = 0 To Me.kromosom.Length - 1
                Me.kromosom(i) = rnd.Next(data(i)(1), data(i)(2))
                jumlahPosisi += Me.kromosom(i)
            Next

            'Perlu diingat bahwa jumlah posisi diatas belum tentu sesuai dengan parameter totalPosisi
            'Oleh karena itu, lakukan penyesuaian posisi agar jumlah posisi selalu bernilai sama dengan parameter totalPosisi
            Dim selisih As Integer = totalPosisi - jumlahPosisi
            Dim idx As Integer = rnd.Next(jumlahGen)
            Dim posisiBaru As Integer = Me.kromosom(idx) + selisih
            If posisiBaru < data(idx)(1) Then Continue Do
            If posisiBaru > data(idx)(2) Then Continue Do
            jumlahPosisi = jumlahPosisi - Me.kromosom(idx) + posisiBaru
            Me.kromosom(idx) = posisiBaru
        Loop

        'Hitung nilai fungsi untuk individu pada posisi tersebut
        'Karena tujuan permasalahan adalah mencari nilai minimal, maka semakin rendah nilai fungsi akan semakin baik
        'Penjelasan lebih detail tentang fungsi ini dapat dilihat pada penjelasan skrip dibawah ini
        Me.nilaiFungsi = hitungNilaiFungsi(Me.kromosom, data)
    End Sub

    'Fungsi untuk mengurutkan nilai fungsi dari yang terendah (terbaik) ke tertinggi (terburuk)
    Public Function CompareTo1(other As Individu) As Integer Implements IComparable(Of Individu).CompareTo
        If Me.nilaiFungsi < other.nilaiFungsi Then
            Return -1
        ElseIf Me.nilaiFungsi > other.nilaiFungsi Then
            Return 1
        Else
            Return 0
        End If
    End Function
End Class

Hasil akhir adalah: (klik untuk perbesar gambar)

Contoh modul / source code dalam bahasa VB (Visual Basic) dapat didownload disini:

Jika membutuhkan jasa kami dalam pembuatan program, keterangan selanjutnya dapat dilihat di Fasilitas dan Harga
Jika ada yang kurang paham dengan langkah-langkah algoritma diatas, silahkan berikan komentar Anda.
Selamat mencoba.