114 lines
3.6 KiB
Plaintext
114 lines
3.6 KiB
Plaintext
Option Base 1
|
|
Public Enum sett
|
|
name_ = 1
|
|
initState
|
|
endState
|
|
blank
|
|
rules
|
|
End Enum
|
|
Public incrementer As Variant, threeStateBB As Variant, fiveStateBB As Variant
|
|
'-- Machine definitions
|
|
Private Sub init()
|
|
incrementer = Array("Simple incrementer", _
|
|
"q0", _
|
|
"qf", _
|
|
"B", _
|
|
Array( _
|
|
Array("q0", "1", "1", "right", "q0"), _
|
|
Array("q0", "B", "1", "stay", "qf")))
|
|
threeStateBB = Array("Three-state busy beaver", _
|
|
"a", _
|
|
"halt", _
|
|
"0", _
|
|
Array( _
|
|
Array("a", "0", "1", "right", "b"), _
|
|
Array("a", "1", "1", "left", "c"), _
|
|
Array("b", "0", "1", "left", "a"), _
|
|
Array("b", "1", "1", "right", "b"), _
|
|
Array("c", "0", "1", "left", "b"), _
|
|
Array("c", "1", "1", "stay", "halt")))
|
|
fiveStateBB = Array("Five-state busy beaver", _
|
|
"A", _
|
|
"H", _
|
|
"0", _
|
|
Array( _
|
|
Array("A", "0", "1", "right", "B"), _
|
|
Array("A", "1", "1", "left", "C"), _
|
|
Array("B", "0", "1", "right", "C"), _
|
|
Array("B", "1", "1", "right", "B"), _
|
|
Array("C", "0", "1", "right", "D"), _
|
|
Array("C", "1", "0", "left", "E"), _
|
|
Array("D", "0", "1", "left", "A"), _
|
|
Array("D", "1", "1", "left", "D"), _
|
|
Array("E", "0", "1", "stay", "H"), _
|
|
Array("E", "1", "0", "left", "A")))
|
|
End Sub
|
|
|
|
Private Sub show(state As String, headpos As Long, tape As Collection)
|
|
Debug.Print " "; state; String$(7 - Len(state), " "); "| ";
|
|
For p = 1 To tape.Count
|
|
Debug.Print IIf(p = headpos, "[" & tape(p) & "]", " " & tape(p) & " ");
|
|
Next p
|
|
Debug.Print
|
|
End Sub
|
|
|
|
'-- a universal turing machine
|
|
Private Sub UTM(machine As Variant, tape As Collection, Optional countOnly As Long = 0)
|
|
Dim state As String: state = machine(initState)
|
|
Dim headpos As Long: headpos = 1
|
|
Dim counter As Long, rule As Variant
|
|
Debug.Print machine(name_); vbCrLf; String$(Len(machine(name_)), "=")
|
|
If Not countOnly Then Debug.Print " State | Tape [head]" & vbCrLf & "---------------------"
|
|
Do While True
|
|
If headpos > tape.Count Then
|
|
tape.Add machine(blank)
|
|
Else
|
|
If headpos < 1 Then
|
|
tape.Add machine(blank), Before:=1
|
|
headpos = 1
|
|
End If
|
|
End If
|
|
If Not countOnly Then show state, headpos, tape
|
|
For i = LBound(machine(rules)) To UBound(machine(rules))
|
|
rule = machine(rules)(i)
|
|
If rule(1) = state And rule(2) = tape(headpos) Then
|
|
tape.Remove headpos
|
|
If headpos > tape.Count Then
|
|
tape.Add rule(3)
|
|
Else
|
|
tape.Add rule(3), Before:=headpos
|
|
End If
|
|
If rule(4) = "left" Then headpos = headpos - 1
|
|
If rule(4) = "right" Then headpos = headpos + 1
|
|
state = rule(5)
|
|
Exit For
|
|
End If
|
|
Next i
|
|
counter = counter + 1
|
|
If counter Mod 100000 = 0 Then
|
|
Debug.Print counter
|
|
DoEvents
|
|
DoEvents
|
|
End If
|
|
If state = machine(endState) Then Exit Do
|
|
Loop
|
|
DoEvents
|
|
If countOnly Then
|
|
Debug.Print "Steps taken: ", counter
|
|
Else
|
|
show state, headpos, tape
|
|
Debug.Print
|
|
End If
|
|
End Sub
|
|
|
|
Public Sub main()
|
|
init
|
|
Dim tap As New Collection
|
|
tap.Add "1": tap.Add "1": tap.Add "1"
|
|
UTM incrementer, tap
|
|
Set tap = New Collection
|
|
UTM threeStateBB, tap
|
|
Set tap = New Collection
|
|
UTM fiveStateBB, tap, countOnly:=-1
|
|
End Sub
|