FANDOM


Alpha Function Version 1

The Alpha Function has been defined using program code shown below. This version contains some errors and will be replaced by Version 2 ... Work in Progress.


Program Code Version 1

The following is VBA visual basic code and will run as a macro in Microsoft Excel. This function creates a string literal of a Strong D Function equal to the Alpha function with any Real number input. The function does not attempt to evaluate the Strong D Function and the run time is therefore very fast.

Option Explicit

Const maxSize = 10, maxNumber = 100

Type StrongD
    Size As Integer
    Place(1 To maxSize) As Integer
    
    RefLib As Integer
    RefPlace As Integer
End Type

Dim LibD(2 To maxNumber) As StrongD, CountD As Integer

Dim aReal As String

Function AlphaS(s As String) As String

Dim i As Integer, j As Integer, e As Boolean

CountD = 2

Select Case Left(s, 1)
Case "0", "1"
    i = MakeD(1)
    If Len(s) = 2 Then i = 0 Else LibD(i).Place(1) = CInt(Left(s, 1))
Case Else
    i = InStr(s, "-")
    j = CInt(Left(s, i - 1))
    aReal = Mid(s, i + 2)

    i = MakeD(j)
    With LibD(i)
        j = j ^ 2 - 1
        If aTest(j, "0") Then
            For j = 1 To .Size
                .Place(j) = LinkD(i, j, .Size)
                Next j
            LibD(.Place(.Size)).Place(.Size) = 0
        Else
            Select Case .Size
            Case 2
                j = 2
            Case 3
                j = 6
            Case 4
                j = 24
            Case Else
                j = 120
                End Select
            If aTest(j, "1") Then
                e = True
                aReal = Mid(aReal, j + 1)
            Else
                e = False
                aRecurse LinkD(i, 1, .Size), 1, False, e
                For j = 2 To .Size
                    .Place(j) = .Place(1)
                    Next j
                End If
                
            aRecurse i, 2, e, e
            End If
        End With
    End Select

AlphaS = StringD(i)
End Function
Function aRecurse(a As Integer, c As Integer, s As Boolean, e As Boolean) As Integer

Dim i As Integer, j As Integer, b As Boolean

b = False

With LibD(a)
    For i = c To .Size
        If s Or b Then
            If i > 1 Then .Place(i) = .Place(i - 1)
            If .Place(i) = 0 Then .Place(i) = 1
            End If
            
        If ExplodeD(a, i) And (s Or b) Then
            CheckD aRecurse(BuildD(a, i, .Place(i - 1)), 1, False, b)
            If .Place(i) = 1 Then .Place(i) = aGet(b)

        Else
            Select Case .Place(i)
            Case 0
                If b Then .Place(i) = aGet(b)
            Case 1
                .Place(i) = aGet(b)
            Case Else
                CheckD aRecurse(CloneD(a, i, .Place(i)), 1, False, b)
                If .Place(i) = 1 Then .Place(i) = aGet(b)
                End Select
            End If
        Next i
    End With
    
aRecurse = a
If Not e Then e = b
End Function
Function aGet(e As Boolean) As Integer

aGet = IIf(aTest(1, "1"), 0, 1)
aReal = Mid(aReal, 2)

If aGet = 0 Then e = True
End Function
Function aTest(t As Integer, s As String) As Boolean

If s = "0" Then aTest = (InStr(Left(aReal, t), s) = 0) And (Len(aReal) >= t) Else aTest = (InStr(Left(aReal, t), s) = 0)
End Function
Function Alpha(d As Double) As String

Alpha = AlphaS(aBinary(d))
End Function
Function aParse(a As String) As String

aParse = Replace(a, "D()", "0")
aParse = Replace(aParse, "D(0)", "1")

aParse = Replace(aParse, "D(1)", "2")
aParse = Replace(aParse, "D(1,0)", "3")
aParse = Replace(aParse, "D(1,1)", "4")
        
aParse = Replace(aParse, "D(1,2)", "5")
aParse = Replace(aParse, "D(1,3)", "6")
aParse = Replace(aParse, "D(1,4)", "7")
aParse = Replace(aParse, "D(2,0)", "8")
aParse = Replace(aParse, "D(2,1)", "11")
aParse = Replace(aParse, "D(2,2)", "14")
aParse = Replace(aParse, "D(2,3)", "17")
aParse = Replace(aParse, "D(2,4)", "20")
aParse = Replace(aParse, "D(3,0)", "59")
aParse = Replace(aParse, "D(3,1)", "185")
aParse = Replace(aParse, "D(3,2)", "563")
aParse = Replace(aParse, "D(3,3)", "1697")
aParse = Replace(aParse, "D(3,4)", "5099")
        
aParse = Replace(aParse, "D(2,5)", "23")
aParse = Replace(aParse, "D(2,6)", "26")
aParse = Replace(aParse, "D(2,7)", "29")
aParse = Replace(aParse, "D(2,8)", "32")
aParse = Replace(aParse, "D(2,11)", "41")
aParse = Replace(aParse, "D(2,14)", "50")
End Function
Function aBinary(d As Double) As String

Const MaxDepth = -15

Dim i As Integer, j As Integer, e As Double, f As Double

e = d

i = 0
While e >= 1
    i = i + 1
    e = e / 2
    Wend

f = 2 ^ (i - 1)
e = d - f
aBinary = i & IIf(d >= 0.5, "-1", "-0")

For j = (i - 2) To MaxDepth Step -1
    f = f / 2
    
    If e >= f Then
        e = e - f
        aBinary = aBinary & "1"
    Else
        aBinary = aBinary & "0"
        End If
    Next j
    
While Right(aBinary, 1) = "0"
    aBinary = Left(aBinary, Len(aBinary) - 1)
    Wend
End Function
Function MakeD(m As Integer) As Integer

Dim i As Integer

MakeD = CountD

With LibD(MakeD)
    .Size = m

    For i = 1 To m
        .Place(i) = 1
        Next i
        
    .RefLib = 0
    .RefPlace = 0
    End With

CountD = CountD + 1
End Function
Function ExplodeD(x As Integer, d As Integer) As Boolean

Dim i As Integer, j As Integer

i = RealSizeD(x)

With LibD(x)
    ExplodeD = (i > 1)
    If Not ExplodeD Then Exit Function
    
    Select Case d
    Case .Size - i + 1
        If .Place(d) < 2 Then Exit Function
    Case .Size - i + 2
        If .Place(d - 1) < 2 Then Exit Function
    
        j = RealSizeD(.Place(d - 1))
        If i > j Then Exit Function
        
        With LibD(.Place(d - 1))
            For j = .Size - j + 1 To .Size
                If .Place(j) = 0 Then Exit Function
                Next j
            End With
        End Select
    End With

ExplodeD = False
End Function
Function RealSizeD(d As Integer) As Integer

Dim i As Integer

With LibD(d)
    RealSizeD = .Size
    For i = 1 To .Size
        If .Place(i) = 0 Then RealSizeD = RealSizeD - 1 Else Exit Function
        Next i
    End With
End Function
Function CheckD(c As Integer) As Boolean

Dim i As Integer

With LibD(c)
    For i = 1 To .Size
        If .Place(i) > 1 Then CheckD .Place(i)
        If .Place(i) > 0 Then Exit Function
        Next i
    
    LibD(.RefLib).Place(.RefPlace) = 1
    End With

End Function
Function LinkD(i As Integer, n As Integer, d As Integer) As Integer

LinkD = MakeD(d)
LibD(i).Place(n) = LinkD

With LibD(LinkD)
    .RefLib = i
    .RefPlace = n
    End With
End Function
Function BuildD(b As Integer, i As Integer, d As Integer) As Integer

Dim j As Integer

BuildD = LinkD(b, i, RealSizeD(b))
With LibD(BuildD)
    For j = 1 To .Size
        .Place(j) = IIf(d = 0, 1, d)
        Next j
    End With
End Function
Function CloneD(c As Integer, n As Integer, ByVal d As Integer) As Integer

Dim i As Integer

CloneD = LinkD(c, n, LibD(d).Size)
With LibD(CloneD)
    For i = 1 To .Size
        .Place(i) = LibD(d).Place(i)
        Next i
    End With
End Function
Function StringD(d As Integer) As String

Dim i As Integer, b As Boolean

b = False
StringD = "D("
If d > 0 Then
    With LibD(d)
        For i = 1 To .Size
            If Not b Then b = (.Place(i) <> 0)
            If b Or i = .Size Then
                If .Place(i) > 1 Then StringD = StringD & StringD(.Place(i)) Else StringD = StringD & .Place(i)
                If i < .Size Then StringD = StringD & ","
                End If
            Next i
        End With
    End If
    
StringD = StringD & ")"
End Function


How the Function Works

A description of how the code works will be provided here ... Work in Progress.

  • VBA Constants
  • VBA Data Structures
  • VBA Functions
    • Alpha Function
    • AlphaS Function
    • aBinary Function - This function converts a real number r into an integer followed by a binary bit string. The integer represents x where r<2^x. The Alpha function then starts generating a nested D function with x parameters based on the binary bit string.
    • Work In Progress

P.S. The program code stops working at Alpha(128+). This is because of the size of the constants being used in the code. It is easy to increase the size of the constants but, I plan to write much more reliable code (Version 2) which will hopefully be easier to understand.

Ad blocker interference detected!


Wikia is a free-to-use site that makes money from advertising. We have a modified experience for viewers using ad blockers

Wikia is not accessible if you’ve made further modifications. Remove the custom ad blocker rule(s) and the page will load as expected.