Penelusuran gejala memanfaatkan linear list (versi 1)

Mekanisme kerja penelusuran (Rabu, 02 Mei 2007)
Dikerjakan setelah lulus kuliah, tapi waktu itu belum dapat pekerjaan, daripada nggak ngapa-ngapain, mending iseng-iseng aja.

Pendahuluan
Penelusuran adalah program untuk melakukan penelusuran terhadap gejala-gejala terurut yang menyebebkan suatu kejadian (penyakit, kerusakan, dsb). Jika gejala-gejala tersebut memiliki urutan yang berbeda, maka kejadian yang dihasilkan akan berbeda pula, tergantung dari aturan yang dibuat.

Kebutuhan
Untuk membuat / memahami program ini hendaknya sudah menguasai, setidaknya mengerti pengetahuan tentang:
@ Sistem Pendukung Keputusan, untuk pembuatan keputusan / kesimpulan
@@ Struktur Data, untuk stack dan linear list
@@@ Teknik Kompilasi (setidaknya Teoi Bahasa dan Otomata), untuk teknik scan dan parse

Sintaks Basis Aturan
Basis aturan memiliki sintaks:
{ gejala { ( ‘dan’ | ‘atau’ ) gejala ) } ‘->‘ } gejala { ( ‘dan’ | ‘atau’ ) gejala ) } ‘=’ kejadian

Urut-urutan gejala dan kejadian tersebut dimasukkan ke dalam linear list, di mana urutan pertama adalah gejala pertama, dilanjutkan dengan gejala selanjutnya dan kejadian menduduki urutan yang paling akhir. Sebelum dimasukkan ke dalam list, dilakukan pengecekan apakah gejala tersebut sudah ada / merupakan salah satu anak dari parent. Pengecekan tidak dilakukan di seluruh list karena akan mengakibatkan perbedaan makna. Alasan menggunakan linear list karena linear list dapat digunakan untuk melakukan backtrack (mungkin hanya ini yang bisa).
Contoh 1:
g1 -> g2 -> g3 = k1
g1 -> g2 = k2
g3 -> g5 atau g6 = k3

Gambar 1. Cara pembuatan linear list untuk contoh 1

Diagram Alir Proses
Keterangan:
proses pertama yang dijalankan adalah start_parsing() dan akan berakhir jika proses rekursif trace berakhir

Gambar 2. Diagram alir proses penelusuran

-----------------------------------------
form (versi 1)
-----------------------------------------
frmKesimpulan.frm

Option Explicit

Private Sub Form_Load() 'program pertama kali berjalan
initMemori memori
Dim i As Integer
Dim at(4) As String
initDatabase AdoAturan, "select aturan from aturan"
initDatabase AdoGejala, "select id_gejala, nama_gejala from gejala order by id_gejala asc"
initDatabase AdoKejadian, "select id_kejadian, nama_kejadian from kejadian order by id_kejadian asc"
initialize_list
With AdoAturan.Recordset
While Not .EOF
parsing ![aturan] 'memeriksa kebenaran aturan, kemudian memasukkan item-item ke dalam list
.MoveNext
Wend
End With
If Not terdapatError Then 'jika tidak ada error sewaktu proses parse
initialize_penelusuran
Trace 0, False 'mulai pelacakan, setiap kejadian akan disimpan
For i = 1 To UBound(str_kejadian) 'mendapatkan semua kejadian / kesimpulan, hasil dari tanya-jawab
Text1.Text = Text1.Text & str_kejadian(i) & vbCrLf
Next i
Else
Text1.Text = definisi_error 'tampilkan error
End If
End Sub

frmPenelusuran.frm

Option Explicit

Dim pertanyaan() As String 'array pertanyaan
Dim id_link() As String 'array id link list

Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Form_Load()
Dim i As Integer
pertanyaan = Split(str_tanya(1), ",") 'pertanyaan dalam format pertanyaan1, pertanyaan2, ..., pertanyaann dipecah ke dalam array
id_link = Split(str_tanya(0), ",") 'id link list dalam format id1, id2, ..., idn dipecah ke dalam array
Text1.Text = str_trace 'menampilkan pertanyaan yang pernah dijawab sebelumnya untuk kasus tertentu
For i = LBound(pertanyaan) To UBound(pertanyaan) 'tampilkan pertanyaan
List1.AddItem pertanyaan(i)
List1.ItemData(List1.ListCount - 1) = id_link(i) 'simpan id link list
Next i
If List1.ListCount > 0 Then List1.ListIndex = 0 'pilih jawaban pertama
If List1.ListCount = 1 Then Option2.Enabled = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
If Option3.Value Then 'Tidak ada satupun gejala yang sesuai dengan daftar gejala [2]
set_semua_sudah_jawab id_link
jawab_penelusuran = -1
ElseIf List1.ListIndex <> -1 Then
If Option1.Value Then set_semua_sudah_jawab id_link 'Ya, tidak ada lagi gejala lain yang sesuai daftar gejala [2]
Else
Cancel = True
End If
Set frmPenelusuran = Nothing
End Sub

Private Sub List1_Click()
jawab_penelusuran = List1.ItemData(List1.ListIndex) 'set jawaban dari pertanyaan
End Sub

-----------------------------------------
modul
-----------------------------------------
mdlDatabase.bas

Option Explicit

Sub adoAddNew(ByRef theAdo As Adodc, cmdDelete As Object, cmdUpdate As Object, Optional setFocusControl As Variant)
On Error GoTo errHandler
theAdo.Refresh
With theAdo.Recordset
.AddNew
End With
If Not IsMissing(setFocusControl) Then setFocusControl.SetFocus
cmdUpdate.Enabled = False
cmdUpdate.Enabled = True
Exit Sub
errHandler:
'errMsg
End Sub

Sub adoUpdate(ByRef theAdo As Adodc, cmdUpdate As Object, Optional setFocusControl As Variant)
On Error GoTo errHandler
Dim curPos As Integer
With theAdo.Recordset
curPos = .AbsolutePosition
.UpdateBatch adAffectAllChapters
MsgBox "Data berhasil diubah", vbInformation, "Informasi"
theAdo.Refresh
.AbsolutePosition = curPos
End With
If Not IsMissing(setFocusControl) Then setFocusControl.SetFocus
cmdUpdate.Enabled = True
Exit Sub
errHandler:
'errMsg
End Sub

Sub adoDelete(ByRef theAdo As Adodc, cmdDelete As Object, cmdUpdate As Object, Optional setFocusControl As Variant)
On Error GoTo errHandler
If Not isDBEmpty(theAdo) Then
With theAdo.Recordset
.Delete
If Not .EOF Then .MoveNext Else .MovePrevious
End With
If Not IsMissing(setFocusControl) Then setFocusControl.SetFocus
End If
MsgBox "Data berhasil dihapus", vbInformation, "Informasi"
theAdo.Refresh
If isDBEmpty(theAdo) Then
cmdUpdate.Enabled = False
cmdUpdate.Enabled = False
Else
cmdUpdate.Enabled = True
cmdUpdate.Enabled = True
End If
Exit Sub
errHandler:
'errMsg
End Sub

Sub adoRefresh(ByRef theAdo As Adodc, cmdDelete As Object, cmdUpdate As Object)
On Error GoTo errHandler
theAdo.Refresh
If isDBEmpty(theAdo) Then
cmdUpdate.Enabled = False
cmdUpdate.Enabled = False
Else
cmdUpdate.Enabled = True
cmdUpdate.Enabled = True
End If
Exit Sub
errHandler:
'errMsg
End Sub

Function isDBEmpty(theAdo As Adodc) As Boolean
If theAdo.Recordset.BOF And theAdo.Recordset.EOF Then isDBEmpty = True Else isDBEmpty = False
End Function

Function isDBInDataArea(theAdo As Adodc) As Boolean
If theAdo.Recordset.BOF Or theAdo.Recordset.EOF Then isDBInDataArea = False Else isDBInDataArea = True
End Function

Sub initDatabase(ByRef theAdo As Adodc, ByVal theRcd As String, Optional cmdDelete As Variant, Optional cmdUpdate As Variant)
On Error GoTo errHandler
theAdo.CommandType = adCmdUnknown
theAdo.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DB_SPK.mdb;Persist Security Info=False"
theAdo.RecordSource = theRcd
theAdo.Refresh
If isDBEmpty(theAdo) Then
If Not IsMissing(cmdUpdate) Then cmdUpdate.Enabled = False
If Not IsMissing(cmdUpdate) Then cmdUpdate.Enabled = False
Else
If Not IsMissing(cmdUpdate) Then cmdUpdate.Enabled = True
If Not IsMissing(cmdUpdate) Then cmdUpdate.Enabled = True
End If
Exit Sub
errHandler:
'errMsg
End Sub

Function autoID(ByVal adoId As Adodc) As Long
Dim i As Long
If Not isDBEmpty(adoId) Then
adoId.Refresh
With adoId.Recordset
For i = 1 To .RecordCount
If i <> CLng(.Fields(0)) Then
autoID = i
Exit Function
End If
.MoveNext
Next
autoID = i
End With
Else
autoID = 1
End If
End Function

cekAturan.bas

Option Explicit
'BNF
'<aturan> ::= <gejala> ( T_KEMUDIAN <gejala> )* T_SEHINGGA <kejadian>
'<gejala> ::= <bool_term> { T_ATAU <bool_term> }
'<bool_term> ::= <gjl> { T_DAN <gjl> }
'<gjl> ::= T_KURUNG_BUKA <gejala> T_KURUNG_TUTUP | T_G T_NOMOR
'<kejadian> ::= T_K T_NOMOR

'inisialisasi id token
Enum Token
T_UNKNOWN = 0
T_ATAU
T_DAN
T_NOMOR
T_KEMUDIAN
T_SEHINGGA
T_G
T_K
T_KURUNG_BUKA
T_KURUNG_TUTUP
End Enum

'inisialisasi spasi kosong
Const TAB_ = 9
Const LINEFEED_ = 10
Const CARRIAGE_RETURN_ = 13
Const SPACE_ = 32

'area public
Public definisi_error As String 'definisi error pada waktu parsing
Public terdapatError As Boolean 'apakah terdapat error

'aera private
Private identifier As String 'identifier {scan, parse}
Private str_gejala As String 'string gejala yang terjadi (sebelum atau sesusah simbol '->') {parse}
Private limit As Long 'batas maksimum panjang string yang diparse/discan {scan, parse}
Private idx As Long 'index karakter saat ini {scan}
Private idx_err As Long 'index karakter tempat terjadi error {parse}
Private CC As String 'karakter saat ini {scan}
Private ADA As Boolean 'akhir dari aturan {parse}
Private input_string As String 'string yang akan di-parse {scan, parse}
Private cToken As Token 'token saat ini {scan, parse}
Private keySymbol() As Variant 'daftar simbol token
Private keyString() As Variant 'daftar nama token

'inisialisasi pengecekan aturan
Sub initialize(Inp As String)
input_string = Inp
reset
keySymbol = Array(T_ATAU, T_DAN, T_G, T_K)
keyString = Array("atau", "dan", "g", "k")
End Sub

' ===
' SCAN
' ===

'melakukan pengesetan ulang
Sub reset()
idx_err = 1
idx = 1
limit = Len(input_string) + 1
ADA = False
terdapatError = False
End Sub

'membaca karakter per karakter
Sub bacaKar()
If boleh_scan Then CC = Mid(input_string, idx, 1)
If idx = limit Then 'jika sudah mencapai limit
ADA = True
Else
idx = idx + 1
End If
End Sub

'mengabaikan spasi
Sub abaikan_spasi()
While (CC = Chr(TAB_) Or CC = Chr(LINEFEED_) Or CC = Chr(SPACE_) Or CC = Chr(CARRIAGE_RETURN_)) And boleh_scan
bacaKar
Wend
End Sub

'baca karakter dilanjutkan mengabaikan spasi
Sub bacaKarakter()
bacaKar
abaikan_spasi
End Sub

'proses scan
Sub scan()
Dim indexKey As Integer
Dim isAllow As Boolean
If boleh_scan Then
idx_err = idx
identifier = ""
Select Case CC
Case "A" To "Z", "a" To "z"
Do
Select Case CC
Case "A" To "Z", "a" To "z"
isAllow = True
identifier = identifier & CC
bacaKar
Case Else
isAllow = False
End Select
Loop Until Not isAllow Or ADA
abaikan_spasi
indexKey = -1
Do
indexKey = indexKey + 1
Loop Until (indexKey = UBound(keyString)) Or (LCase(identifier) = keyString(indexKey))
If LCase(identifier) = keyString(indexKey) Then cToken = keySymbol(indexKey) Else cToken = T_UNKNOWN
Case "0" To "9"
Do
Select Case CC
Case "0" To "9"
isAllow = True
identifier = identifier & CC
bacaKar
Case Else: isAllow = False
End Select
Loop Until Not isAllow Or ADA
abaikan_spasi
cToken = T_NOMOR
Case "-"
bacaKarakter
If CC = ">" Then cToken = T_KEMUDIAN Else cToken = T_UNKNOWN
bacaKarakter
Case "="
cToken = T_SEHINGGA
bacaKarakter
Case "("
cToken = T_KURUNG_BUKA
bacaKarakter
Case ")"
cToken = T_KURUNG_TUTUP
bacaKarakter
Case Else
cToken = T_UNKNOWN
bacaKarakter
End Select
End If
End Sub

'apakah masih boleh melakukan scan??
Function boleh_scan() As Boolean
If ADA Or terdapatError Then boleh_scan = False Else boleh_scan = True
End Function

' ===
' PENANGANAN ERROR
' ===

'mendaftarkan error
Sub set_error(Id As Byte)
If Not terdapatError Then 'jika terjadi / ada error, berlaku 1 kali error, hanya untuk error pertama
terdapatError = True
Select Case Id
Case 1: definisi_error = "kolom " & idx_err - 1 & ", tidak terdapat simbol g"
Case 2: definisi_error = "kolom " & idx_err - 1 & ", tidak terdapat nomor"
Case 3: definisi_error = "kolom " & idx_err - 1 & ", tidak terdapat simbol k"
Case 4: definisi_error = "kolom " & idx_err - 1 & ", tidak terdapat simbol ="
Case 5: definisi_error = "kolom " & idx_err - 1 & ", kekurangan simbol )"
End Select
End If
End Sub

' ===
' PARSE
' ===

'melakukan parsing terhadap masukan
Sub parsing(Inp As String)
If Not terdapatError Then
initialize Inp
bacaKarakter
aturan
End If
End Sub

'<aturan> ::= <gejala> ( T_KEMUDIAN <gejala> )* T_SEHINGGA <kejadian>
Sub aturan()
Dim orang_tua As Long
str_gejala = ""
scan
gejala
orang_tua = tambah_anak_(0, str_gejala) 'sisipkan ke dalam list
While cToken = T_KEMUDIAN And boleh_scan
str_gejala = ""
scan
gejala
orang_tua = tambah_anak_(orang_tua, str_gejala) 'sisipkan ke dalam list
Wend
If cToken = T_SEHINGGA Then
str_gejala = ""
scan
kejadian
orang_tua = tambah_anak_(orang_tua, str_gejala) 'sisipkan ke dalam list
Else
set_error 4
End If
End Sub

'<gejala> ::= <bool_term> { T_ATAU <bool_term> }
Sub gejala()
bool_term
While cToken = T_ATAU And boleh_scan
str_gejala = str_gejala & " atau "
scan
bool_term
Wend
End Sub

'<bool_term> ::= <gjl> { T_DAN <gjl> }
Sub bool_term()
gjl
While cToken = T_DAN And boleh_scan
str_gejala = str_gejala & " dan "
scan
gjl
Wend
End Sub

'<gjl> ::= T_KURUNG_BUKA <gejala> T_KURUNG_TUTUP | T_G T_NOMOR
Sub gjl()
If cToken = T_KURUNG_BUKA Then
str_gejala = str_gejala & "("
scan
gejala
If cToken = T_KURUNG_TUTUP Then
str_gejala = str_gejala & ")"
scan
Else
set_error 5
End If
ElseIf cToken = T_G Then
'str_gejala = str_gejala & identifier
scan
If cToken = T_NOMOR Then
With frmKesimpulan.AdoGejala.Recordset
.Find "id_gejala = " & identifier, , adSearchForward, 1
If Not (.EOF And .BOF) Then str_gejala = str_gejala & !nama_gejala
End With
scan
Else
set_error 2
End If
Else
set_error 1
End If
End Sub

'<kejadian> ::= T_K T_NOMOR
Sub kejadian()
If cToken = T_K Then
str_gejala = str_gejala & "= "
scan
If cToken = T_NOMOR Then
With frmKesimpulan.AdoKejadian.Recordset
.Find "id_kejadian = " & identifier, , adSearchForward, 1
If Not (.EOF And .BOF) Then str_gejala = str_gejala & !nama_kejadian
End With
scan
Else
set_error 2
End If
Else
set_error 3
End If
End Sub

ListAturan.bas

Option Explicit

'tipe data list
Type List
Id As String 'id / string dari list
Links() As Long 'daftar anak / link dari list
SudahJawab As Boolean 'apakah list sudah terjawab??
End Type

'area public
Public LinkList() As List 'list
Public N As Long 'banyaknya anggota list

'inisialisasi list
Sub initialize_list()
ReDim LinkList(0)
LinkList(0).Id = "root"
ReDim LinkList(0).Links(0)
LinkList(0).Links(0) = -1
N = 0
End Sub

'menambah anak ke orang tua
Function tambah_anak_(idx_orang_tua As Long, id_anak As String) As Long
Dim idx_list_kembaran As Long
idx_list_kembaran = cari_kembaran(idx_orang_tua, id_anak)
If idx_list_kembaran = -1 Then 'jika tidak ada yang sama (tidak kembar)
N = N + 1
ReDim Preserve LinkList(N)
LinkList(N).Id = id_anak
ReDim LinkList(N).Links(0)
LinkList(N).Links(0) = -1
isi_link_ idx_orang_tua, N
tambah_anak_ = N
Else
tambah_anak_ = idx_list_kembaran 'tidak terjadi penyisipan, dirinya sama dengan kembarannya
End If
End Function

'mengisi anak dari orang tua
Sub isi_link_(ByVal idx_list_orang_tua As Long, idx_list_anak As Long)
Dim i As Long
If LinkList(idx_list_orang_tua).Links(0) <> -1 Then ReDim Preserve LinkList(idx_list_orang_tua).Links(UBound(LinkList(idx_list_orang_tua).Links) + 1)
LinkList(idx_list_orang_tua).Links(UBound(LinkList(idx_list_orang_tua).Links)) = idx_list_anak
End Sub

'apakah anak sudah merupakan anak dari orang tua (apakah ada kembaran)
Function cari_kembaran(idx_orang_tua As Long, idx As String) As Long
Dim i As Long
For i = 0 To UBound(LinkList(idx_orang_tua).Links)
If LinkList(idx_orang_tua).Links(i) <> -1 Then
If idx = LinkList(LinkList(idx_orang_tua).Links(i)).Id Then GoTo ret:
End If
Next i
cari_kembaran = -1
Exit Function
ret:
cari_kembaran = LinkList(idx_orang_tua).Links(i)
End Function

' old version of tambah_anak
'
'Sub tambah_anak(idx_orang_tua As String, id_anak As String)
' Dim idx_list As Long
' Dim idx_list_kembaran As Long
' idx_list = cari_list(idx_orang_tua)
' idx_list_kembaran = cari_kembaran(idx_list, id_anak)
' If idx_list_kembaran = -1 Then
' N = N + 1
' ReDim Preserve LinkList(N)
' LinkList(N).Id = id_anak
' ReDim LinkList(N).Links(0)
' LinkList(N).Links(0) = -1
' isi_link_ idx_list, N
' End If
'End Sub

' old version of isi_link
'
'Sub isi_link(ByVal idx_orang_tua As String, idx_list_anak As Long)
' Dim idx_list As Long
' Dim i As Long
' idx_list = cari_list(idx_orang_tua)
' If LinkList(idx_list).Links(0) <> -1 Then ReDim Preserve LinkList(idx_list).Links(UBound(LinkList(idx_list).Links) + 1)
' LinkList(idx_list).Links(UBound(LinkList(idx_list).Links)) = idx_list_anak
'End Sub

' digunakan pada tambah_anak dan isi_link
'
'Function cari_list(idx As String) As Long
' Dim i As Long
' For i = 0 To N
' If idx = LinkList(i).Id Then GoTo ret:
' Next i
' i = -1
'ret:
'cari_list = i
'End Function

TelusuriAturan.bas

Option Explicit

'area public
Public jawab_penelusuran As Long 'jawaban dari penelusuran
Public str_trace As String 'menampilkan daftar pertanyaan yang sudah pernah dilalui sebelumnya
Public str_tanya() As String 'daftar pertanyaan yang disajikan
Public str_kejadian() As String 'daftar kejadian yang dihasilkan

'area private
Private ketemu_kejadian As Boolean 'apakah kejadian ditemukan??

'inisialisai penelusuran aturan
Sub initialize_penelusuran()
ReDim str_kejadian(0)
reset_sudahjawab 0
End Sub

'penelusuran left to right
Sub LR(idx As Long)
Dim i As Long
For i = 0 To UBound(LinkList(idx).Links)
If LinkList(idx).Links(i) <> -1 Then LR LinkList(idx).Links(i)
Next i
End Sub

'melakukan set ulang pada semua list menjadi belum menjawab
Sub reset_sudahjawab(idx As Long)
Dim i As Long
For i = 0 To UBound(LinkList(idx).Links)
LinkList(idx).SudahJawab = False
If LinkList(idx).Links(i) <> -1 Then LR LinkList(idx).Links(i)
Next i
End Sub

'melakukan pelacakan
Sub Trace(idx As Long, isBackTrace As Boolean)
Dim idx_jawab As Long
If Not isBackTrace Then 'jika bukan backtrace, maka menyimpan informasi yang dibutuhkan sewaktu terjadi back trace, dengan menyimpannya ke dalam stack
push memori, str_trace & " -> " & LinkList(idx).Id
str_trace = str_trace & " -> " & LinkList(idx).Id
End If
'MsgBox str_trace
str_tanya = daftar_anak_belum_jawab(idx) 'mendaftar pertanyaan yang belum terjawab
If Trim(str_tanya(0)) <> "" Then 'jika ada pertanyaan
idx_jawab = pertanyaan 'berhenti, menanti jawaban, lanjut..
If idx_jawab <> -1 Then 'jika ada jawaban
Dim i As Long
'tampilkan kejadian / kesimpulan (jika ada)
For i = 0 To UBound(LinkList(idx_jawab).Links)
If Left(LinkList(LinkList(idx_jawab).Links(i)).Id, 1) = "=" Then
ReDim Preserve str_kejadian(UBound(str_kejadian) + 1)
str_kejadian(UBound(str_kejadian)) = str_trace & " -> " & LinkList(idx_jawab).Id & " " & LinkList(LinkList(idx_jawab).Links(i)).Id
'MsgBox LinkList(LinkList(idx_jawab).Links(0)).Id
End If
Next i
LinkList(idx_jawab).SudahJawab = True 'berarti pertanyaan yang ini sudah terjawab
Trace idx_jawab, False 'pertanyaan berikutnya
str_trace = pop_(memori) 'mempersiapkan urutan jawaban yang pernah dijawab (backtraking)
Trace idx, True 'backtrace terjadi di sini
End If
End If
End Sub

'melakukan set ulang pada semua list yang sesuai dengan daftar menjadi sudah menjawab
Sub set_semua_sudah_jawab(list_idx() As String)
Dim i As Long
For i = 0 To UBound(list_idx)
LinkList(list_idx(i)).SudahJawab = True
Next i
End Sub

'mendapatkan daftar anak yang belum menjawab
Function daftar_anak_belum_jawab(idx As Long) As String()
Dim i As Long
Dim temp(1) As String
For i = 0 To UBound(LinkList(idx).Links)
If LinkList(idx).Links(i) <> -1 Then
If LinkList(LinkList(idx).Links(i)).SudahJawab = False And Not Left(LinkList(LinkList(idx).Links(i)).Id, 1) = "=" Then
temp(0) = temp(0) & LinkList(idx).Links(i) & ","
temp(1) = temp(1) & LinkList(LinkList(idx).Links(i)).Id & ","
End If
End If
Next i
If Trim(temp(0)) <> "" Then
temp(0) = Left$(temp(0), Len(temp(0)) - 1)
temp(1) = Left$(temp(1), Len(temp(1)) - 1)
End If
daftar_anak_belum_jawab = temp
End Function

'berhenti sejenak untuk mengajukan pertanyaan ke pengguna
Function pertanyaan() As Long
frmPenelusuran.Show vbModal
pertanyaan = jawab_penelusuran
End Function

VirtualMemory.bas

'are public
Public memori() As Variant 'virtual memori

'inisialisasi virtual memori
Sub initMemori(ByRef mem As Variant)
ReDim mem(0)
End Sub

'memasukkan nilai ke dalam stack
Sub push(ByRef mem As Variant, ByVal nilai As Variant)
ReDim Preserve mem(UBound(mem) + 1)
mem(UBound(mem)) = nilai
End Sub

'mendapatkan nilai dari puncak stack kemudian menghapus yang teratas
Function pop(ByRef mem As Variant) As Variant
pop = mem(UBound(mem))
ReDim Preserve mem(UBound(mem) - 1)
End Function

'menghapus yang teratas kemudian mendapatkan nilai dari puncak stack
Function pop_(ByRef mem As Variant) As Variant
ReDim Preserve mem(UBound(mem) - 1)
pop_ = mem(UBound(mem))
End Function

-----------------------------------------
basis data
-----------------------------------------