Algoritma BCO (Bee Colony Optimization) 18

Algoritma BCO (Bee Colony Optimization) adalah salah satu algoritma yang digunakan untuk pencarian jalur. Contoh yang dibahas kali ini adalah mengenai pencarian jalur yang melalui semua titik tujuan dengan jarak paling rendah.
Bee Colony Optimization adalah algoritma optimasi yang berdasarkan pada tingkah laku kumpulan lebah madu dalam sebuah koloni untuk menemukan sumber makanan. Kemungkinan solusi dilambangkan dengan posisi sumber makanan, sedangkan nilainya dilambangkan dengan jumlah nektar yang terdapat dalam sumber makanan tersebut.

Diasumsikan ada sebaran titik yang harus dilalui semuanya
semua titik terhubung secara langsung dengan titik-titik lainnya, dan semua jalurnya dapat dilalui 2 arah
Jarak antar titik pada semua titik akan diambil secara acak antara angka 1 sampai 10
Tentukan Jalur yang harus diambil untuk mengelilingi semua titik dengan jarak terpendek

Sebelum masuk kedalam langkah-langkah pembahasan algoritma, ada beberapa konstanta atau parameter yang harus diketahui, yaitu:
* Tentukan jumlah lebah yang digunakan dalam perhitungan
Dalam dunia nyata, dalam 1 sarang lebah, biasanya terdapat 5.000 – 20.000 lebah
Diasumsikan dalam kasus ini, jumlah lebah hanya ada 100, karena semakin besar angkanya, semakin lama perhitungannya

Const totalLebah As Integer = 100

* Tentukan jumlah lebah aktif, lebah nonaktif, dan lebah pencari
Jumlah ketiga jenis lebah ini harus sama dengan variabel jumlah lebah diatas
Dalam dunia nyata, perbandingan lebah aktif : lebah nonaktif : lebah pencari adalah kira-kira 75% : 10% : 15%
Diasumsikan dalam kasus ini, perbandingan tersebut akan digunakan untuk mendeklarasikan jumlah masing-masing jenis lebah

Const totalLebahAktif As Integer = 75
Const totalLebahNonaktif As Integer = 10
Const totalLebahPencari As Integer = 15

* Tentukan jumlah maksimal perjalanan yang dapat dilakukan lebah sebelum harus kembali ke sarangnya
Ini mencegah seekor lebah keluar terlalu lama karena tidak mendapatkan perjalanan yang lebih baik dari perjalanan yang sudah ditempuhnya.
Diasumsikan dalam kasus ini, jumlah maksimal perjalanan adalah 100

Const totalPerjalanan As Integer = 100

* Tentukan jumlah iterasi yang dilakukan untuk masing-masing lebah
Semakin besar angkanya, semakin optimal hasil perhitungannya, tetapi semakin lama perhitungannya
Diasumsikan dalam kasus ini, jumlah iterasi adalah 1000

Const totalIterasi As Integer = 1000

Langkah-langkah penggunaan algoritma ini adalah

1. Inisialisasi sarang lebah beserta semua obyek yang ada di dalamnya
Buat lebah sebanyak parameter total Lebah
Beri status pada masing-masing lebah sesuai dengan parameter total lebah aktif, total lebah nonaktif, total lebah pencari
Tentukan jalur acak pada masing-masing lebah, kemudian cari jejak terpendek sementara yang diperoleh secara acak
Simpan jalur terbaik sementara berdasarkan jalur dengan jarak terpendek
Penjelasan lebih detail tentang fungsi ini dapat dilihat pada penjelasan skrip dibawah ini

Dim sarangLebah As New sarangLebah(totalLebah, totalLebahNonaktif, totalLebahAktif, totalLebahPencari, totalPerjalanan, totalIterasi, daftarTitik)

* Agar dapat menjalankan skrip diatas, maka diperlukan sebuah Class sarangLebah untuk menampung data seperti daftar lebah, data titik, jalur terbaik, dan nilai jalur terbaik. Deklarasi Class sarangLebah adalah sebagai berikut:

Friend Class sarangLebah
	Public Class lebah
		Public status As Integer            'jika berisi nilai 0 berarti nonAktif, 1 berarti aktif, 2 berarti pencari
		Public jalur() As Char              'jalur yang ditempuh oleh lebah tersebut
		Public nilaiJalur As Double         'nilai jarak yang ditempuh, semakin rendah semakin baik
		Public jumlahPerjalanan As Integer  'menghitung berapa kali lebah sudah melakukan perjalanan

		Public Sub New(ByVal status As Integer,
					   ByVal jalur() As Char,
					   ByVal nilaiJalur As Double,
					   ByVal jumlahPerjalanan As Integer
					   )
			Me.status = status
			Me.jalur = New Char(jalur.Length - 1) {}
			Array.Copy(jalur, Me.jalur, jalur.Length)
			Me.nilaiJalur = nilaiJalur
			Me.jumlahPerjalanan = jumlahPerjalanan
		End Sub
	End Class 'lebah

	Private Shared random As Random = Nothing

	Public daftarTitik As daftarTitik 'this is the problem-specific data we want to optimize

	Public totalLebah As Integer
	Public totalLebahNonaktif As Integer
	Public totalLebahAktif As Integer
	Public totalLebahPencari As Integer

	Public totalIterasi As Integer

	Public totalPerjalanan As Integer       'jumlah maksimal lebah boleh melakukan perjalanan untuk mencari titik tetangga dengan solusi lebih baik
	Public probTerbujuk As Double = 0.9     'kemungkinan lebah nonaktif untuk menerima solusi yang diberikan sewaktu tarian waggle
	Public probKesalahan As Double = 0.01   'kemungkinan lebah aktif menolak solusi yang lebih baik atau menerima solusi yang lebih buruk

	Public daftarLebah() As lebah
	Public jalurTerbaik() As Char
	Public nilaiJalurTerbaik As Double
	Public daftarindeksLebahNonAktif() As Integer 'daftar indeks untuk lebah nonaktif

	Public Sub New(ByVal totalLebah As Integer, ByVal totalLebahNonaktif As Integer, ByVal totalLebahAktif As Integer, ByVal totalLebahPencari As Integer, ByVal totalPerjalanan As Integer, ByVal totalIterasi As Integer, ByVal daftarTitik As daftarTitik)
		random = New Random(0)

		Me.totalLebah = totalLebah
		Me.totalLebahNonaktif = totalLebahNonaktif
		Me.totalLebahAktif = totalLebahAktif
		Me.totalLebahPencari = totalLebahPencari
		Me.totalPerjalanan = totalPerjalanan
		Me.totalIterasi = totalIterasi

		Me.daftarTitik = daftarTitik

		Me.daftarLebah = New lebah(totalLebah - 1) {}
		Me.jalurTerbaik = TentukanJalurAcak()
		Me.nilaiJalurTerbaik = nilaiJalur(Me.jalurTerbaik)

		Me.daftarindeksLebahNonAktif = New Integer(totalLebahNonaktif - 1) {} 'menampung indeks lebah-lebah yang sedang nonaktif

		For i = 0 To totalLebah - 1
			Dim statusLebah As Integer
			If i < totalLebahNonaktif Then
				statusLebah = 0 'lebah nonAktif
				daftarindeksLebahNonAktif(i) = i 'lebah dengan indeks i adalah lebah nonaktif
			ElseIf i < totalLebahNonaktif + totalLebahPencari Then
				statusLebah = 2 'lebah pencari
			Else
				statusLebah = 1 'lebah aktif
			End If

			Dim jalurAcak() As Char = TentukanJalurAcak()
			Dim mq As Double = nilaiJalur(jalurAcak)
			Dim jumlahPerjalanan = 0

			daftarLebah(i) = New lebah(statusLebah, jalurAcak, mq, jumlahPerjalanan)

			'Apakah lebah ini memiliki solusi lebih baik dari solusi umum?
			'Jika benar, maka ambil jalur ini sebagai jalur terbaik sementara
			If daftarLebah(i).nilaiJalur < nilaiJalurTerbaik Then
				Array.Copy(daftarLebah(i).jalur, Me.jalurTerbaik, daftarLebah(i).jalur.Length)
				Me.nilaiJalurTerbaik = daftarLebah(i).nilaiJalur
			End If
		Next i
	End Sub
	
	. . .
End Class

2. Lakukan proses perhitungan sebanyak jumlah perulangan
Penjelasan lebih detail tentang fungsi ini dapat dilihat pada penjelasan skrip dibawah ini (poin 3 - 5)

sarangLebah.prosesPerhitungan()

Memasuki perhitungan pada proses prosesPerhitungan

* Lakukan proses perulangan sebanyak jumlah iterasi untuk semua lebah yang berada pada daftar lebah
Lakukan proses perhitungan sesuai dengan status lebah yang sedang diproses

3. Jika lebah ini lebah aktif, maka lakukan proses perhitungan untuk lebah aktif

If Me.daftarLebah(i).status = 1 Then
	ProsesLebahAktif(i)
. . .

3a. Tentukan jalur baru untuk lebah ini

Dim jalurBaru() = TentukanJalurBaru(daftarLebah(i).jalur)

3b. Hitung nilai jalur untuk jalur yang baru ditemukan

Dim nilaiJalurBaru = nilaiJalur(jalurBaru)

3c. Jika jalur yang baru ternyata lebih baik dari jalur lebah tersebut

3c1. Tentukan apakah nilai acak kurang dari nilai probabilitas kesalahan
Jika benar maka Lebah melakukan kesalahan, sehingga menolak solusi yang lebih baik

If prob < probKesalahan Then
	daftarLebah(i).jumlahPerjalanan += 1                            'Tidak mengambil jalur tersebut, tetapi menambah jumlah perjalanan
	If daftarLebah(i).jumlahPerjalanan > totalPerjalanan Then
		jumlahPerjalananMelebihiMaks = True
	End If
. . .

3c2. Jika tidak maka lebah tidak melakukan kesalahan, sehingga menerima solusi yang baru

. . .
Else                                                                '
	Array.Copy(jalurBaru, daftarLebah(i).jalur, jalurBaru.Length)   'ambil jalur baru sebagai jalur lebah tersebut
	daftarLebah(i).nilaiJalur = nilaiJalurBaru
	daftarLebah(i).jumlahPerjalanan = 0                             'reset jumlah perjalanan lebah tersebut
	AmbilJalurBaru = True                                           'Lakukan tarian waggle pada saat lebah ini kembali ke sarang
End If

3d. Jika jalur yang baru ternyata tidak lebih baik dari jalur lebah tersebut

3d1. Tentukan apakah nilai acak kurang dari nilai probabilitas kesalahan
Jika benar maka lebah melakukan kesalahan, sehingga menerima solusi yang lebih buruk

If prob < probKesalahan Then
	Array.Copy(jalurBaru, daftarLebah(i).jalur, jalurBaru.Length)   'ambil jalur baru sebagai jalur lebah tersebut
	daftarLebah(i).nilaiJalur = nilaiJalurBaru
	daftarLebah(i).jumlahPerjalanan = 0                             'reset jumlah perjalanan lebah tersebut
	AmbilJalurBaru = True                                           'Lakukan tarian waggle pada saat lebah ini kembali ke sarang
. . .

3d2. Jika tidak maka lebah tidak melakukan kesalahan, sehingga menolak solusi yang baru

. . .
Else
	daftarLebah(i).jumlahPerjalanan += 1                            'Tidak mengambil jalur tersebut, tetapi menambah jumlah perjalanan
	If daftarLebah(i).jumlahPerjalanan > totalPerjalanan Then
		jumlahPerjalananMelebihiMaks = True
	End If
End If

3e. Setelah perhitungan tersebut, maka lebah akan kembali ke sarang
ada 3 kemungkinan keadaan pada saat lebah sudah berada di sarang:

3e1. Jika jumlah perjalanan lebah tersebut sudah melebihi maksimum perjalanan, maka lebah ini akan berubah menjadi lebah nonaktif

If jumlahPerjalananMelebihiMaks = True Then
	daftarLebah(i).status = 0                               'lebah akan berubah menjadi lebah nonaktif
	daftarLebah(i).jumlahPerjalanan = 0                     'reset jumlah perjalanan lebah tersebut
	Dim x As Integer = random.Next(totalLebahNonaktif)      'ambil lebah nonaktif secara acak
	daftarLebah(daftarindeksLebahNonAktif(x)).status = 1    'ubah status lebah tersebut menjadi lebah aktif
	daftarindeksLebahNonAktif(x) = i                        'Catat lebah ini kedalam daftar lebah nonaktif
. . .

3e2. Jika jalur baru diterima oleh lebah tersebut, maka lakukan pengecekan apakah jalur baru ini lebih baik dari solusi umum. Kemudian lakukan tarian waggle

. . .
ElseIf AmbilJalurBaru = True Then
	'Jika jalur lebah yang baru ternyata lebih baik dari solusi umum
	If daftarLebah(i).nilaiJalur < Me.nilaiJalurTerbaik Then
		Array.Copy(daftarLebah(i).jalur, Me.jalurTerbaik, daftarLebah(i).jalur.Length)  'ambil Jalur ini sebagai jalur terbaik
		Me.nilaiJalurTerbaik = daftarLebah(i).nilaiJalur

		Dim s = "lebah " & (i) & vbLf
		s &= "jalur baru yang ditemukan: "
		For i = 0 To Me.jalurTerbaik.Length - 2
			s &= (Me.jalurTerbaik(i)) & "->"
		Next i
		s &= (Me.jalurTerbaik(Me.jalurTerbaik.Length - 1)) & vbLf

		s &= "jarak yang ditempuh:    "
		If nilaiJalurTerbaik < 10000.0 Then
			s &= nilaiJalurTerbaik.ToString("F2") & vbLf
		Else
			s &= nilaiJalurTerbaik.ToString("#.####e+00")
		End If
		Console.WriteLine(s)
	End If

	'Lakukan Tarian Waggle
	'Penjelasan lebih detail tentang fungsi ini dapat dilihat pada penjelasan skrip dibawah ini
	TarianWaggle(i)
. . .

3e3. Tidak terjadi apa-apa (lebah hanya kembali ke sarang)

. . . 
Else
	Return
End If

* Lakukan fungsi ini jika jalur baru telah diterima oleh lebah
Dalam dunia nyata, tarian waggle dilakukan oleh lebah untuk mengirimkan informasi kepada teman lebahnya mengenai sumber makanan yang lebih baik
Penjelasan lebih detail tentang fungsi ini dapat dilihat pada penjelasan skrip dibawah ini

Private Sub TarianWaggle(ByVal i As Integer)
	'Lakukan perulangan untuk setiap lebah nonaktif
	For ii = 0 To totalLebahNonaktif - 1
		Dim b = daftarindeksLebahNonAktif(ii)   'indeks lebah nonaktif
		If daftarLebah(b).status <> 0 Then
			Throw New Exception("Terjadi kesalahan: lebah ini bukan lebah nonaktif")
		End If
		If daftarLebah(b).jumlahPerjalanan <> 0 Then
			Throw New Exception("Terjadi kesalahan: ditemukan lebah nonaktif dengan jumlah perjalanan tidak sama dengan 0")
		End If

		'Jika jalur lebah pencari lebih baik dari jalur lebah nonaktif
		'Cari nilai acak untuk dibandingkan dengan probabilitas terbujuk
		'Jika nilai acak tersebut kurang dari probabilitas terbujuk, maka ambil jalur dari lebah pencari sebagai jalur lebah nonaktif
		If daftarLebah(i).nilaiJalur < daftarLebah(b).nilaiJalur Then
			Dim p = random.NextDouble()
			If Me.probTerbujuk > p Then         'apakah lebah nonAktif akan terbujuk oleh lebah pencari? (biasanya terbujuk, karena nilai probTerbujuk sangat tinggi, ~0.90)
				Array.Copy(daftarLebah(i).jalur, daftarLebah(b).jalur, daftarLebah(i).jalur.Length)
				daftarLebah(b).nilaiJalur = daftarLebah(i).nilaiJalur
			End If
		End If
	Next ii
End Sub

4. Lakukan fungsi ini jika status lebah adalah lebah pencari

. . .
ElseIf Me.daftarLebah(i).status = 2 Then
	ProsesLebahPencari(i)
. . .

4a. Tentukan jalur acak untuk lebah ini

Dim jalurAcak() As Char = TentukanJalurAcak()           'Lebah pencari mencari jalur acak

4b. Hitung nilai jalur untuk jalur acak tersebut

Dim nilaiJalurAcak As Double = nilaiJalur(jalurAcak)    'tentukan jarak yang ditempuh

4c. jika nilai jalur acak ternyata lebih rendah dari nilai jalur terpendek lebah tersebut
maka lebah pencari menemukan solusi yang lebih baik dari solusi yang pernah ditemukan sebelumnya

4c1. ambil jalur ini sebagai jalur terbaik lebah tersebut

Array.Copy(jalurAcak, daftarLebah(i).jalur, jalurAcak.Length)
daftarLebah(i).nilaiJalur = nilaiJalurAcak

4c2. Apabila jalur acak ternyata lebih baik dari solusi umum
maka Ambil jalur ini sebagai solusi umum

If daftarLebah(i).nilaiJalur < nilaiJalurTerbaik Then
	Array.Copy(daftarLebah(i).jalur, Me.jalurTerbaik, daftarLebah(i).jalur.Length)
	Me.nilaiJalurTerbaik = daftarLebah(i).nilaiJalur
. . .

4c3. Lakukan Tarian Waggle

TarianWaggle(i)

5. Lakukan fungsi ini jika status lebah adalah lebah nonaktif

Private Sub ProsesLebahNonaktif(ByVal i As Integer)
	Return 'Tidak ada yang perlu dilakukan
End Sub

* Untuk menyimpan data titik dan jarak antar titik, diperlukan sebuah class tersendiri yang tidak berhubungan dengan class sarang lebah, yaitu class daftarTitik. Deklarasi class daftarTitik adalah sebagai berikut:

Friend Class daftarTitik
	Public titik() As Char
	Public jarakAntarTitik()() As Integer

	Public Sub New(ByVal jumlahTitik As Integer)
		Me.titik = New Char(jumlahTitik - 1) {}
		Me.titik(0) = "A"c
		For i = 1 To Me.titik.Length - 1
			Me.titik(i) = CChar(ChrW(AscW(Me.titik(i - 1)) + 1))
		Next i

		Me.jarakAntarTitik = New Integer(jumlahTitik - 1)() {}
		For i As Integer = 0 To jarakAntarTitik.Length - 1
			Me.jarakAntarTitik(i) = New Integer(jumlahTitik - 1) {}
		Next i

		Dim random As New Random(0)
		For i As Integer = 0 To jumlahTitik - 1
			For j As Integer = i + 1 To jumlahTitik - 1
				Dim d As Integer = random.Next(1, 10)
				jarakAntarTitik(i)(j) = d
				jarakAntarTitik(j)(i) = d
			Next j
		Next i
	End Sub

	Public Function Jarak(ByVal titikPertama As Char, ByVal titikKedua As Char) As Double
		Return jarakAntarTitik(Asc(titikPertama) - 65)(Asc(titikKedua) - 65)
	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.