Tuesday, February 25, 2014

[VBScript] How can I display 64 bit double number using VBScript on 32 Bit OS?

"How can I display 64 bit double number using VBScript on 32 Bit OS?" That was the question on StackOverflow back at the end of 2012. And nobody had answered it. What a challenge!

I assumed a pure-VBScript solution was needed, and set about finding and implementing a Very Large Integer class with which I could then implement a Hex64 to integer function. A workable candidate function was found on Rosetta Code in the
Liberty BASIC solution to the Long Multiplication task.

The code for the class is as follows. It's pretty much the same as the original.

Option Explicit
Class VeryLongInteger
  'http://rosettacode.org/wiki/Long_Multiplication#Liberty_BASIC
  Public Function MULTIPLY(Str_A, Str_B)
    Dim signA, signB, sResult, Str_Shift, i, d, Str_T
    signA = 1
    If Left(Str_A,1) = "-" Then 
      Str_A = Mid(Str_A,2)
      signA = -1
    End If
    signB = 1
    If Left(Str_B,1) = "-" Then 
      Str_B = Mid(Str_B,2)
      signB = -1
    End If
    sResult = vbNullString
    Str_T = vbNullString
    Str_shift = vbNullString
    For i = Len(Str_A) To 1 Step -1
      d = CInt(Mid(Str_A,i,1))
      Str_T = MULTBYDIGIT(Str_B, d)
      sResult = ADD(sResult, Str_T & Str_shift)
      Str_shift = Str_shift & "0"
      'print d, Str_T, sResult 
    Next
    If signA * signB < 0 Then sResult = "-" + sResult
    'print sResult
    MULTIPLY = sResult
  End Function
  
  Private Function MULTBYDIGIT(Str_A, d)
    Dim sResult, carry, i, a, c
    'multiply Str_A by digit d
    sResult = vbNullString
    carry = 0
    For i = Len(Str_A) To 1 Step -1
      a = CInt(Mid(Str_A,i,1))
      c = a * d + carry
      carry = c \ 10
      c = c Mod 10
      'print a, c
      sResult = CStr(c) & sResult 
    Next
    If carry > 0 Then sResult = CStr(carry) & sResult
    'print sResult
    MULTBYDIGIT = sResult
  End Function
  
  Public Function ADD(Str_A, Str_B)
    Dim L, sResult, carry, i, a, b, c
    'add Str_A + Str_B, for now only positive
    l = MAX(Len(Str_A), Len(Str_B))
    Str_A=PAD(Str_A,l)
    Str_B=PAD(Str_B,l)
    sResult = vbNullString 'result
    carry = 0
    For i = l To 1 Step -1
      a = CInt(Mid(Str_A,i,1))
      b = CInt(Mid(Str_B,i,1))
      c = a + b + carry
      carry = Int(c/10)
      c = c Mod 10
      'print a, b, c
      sResult = CStr(c) & sResult
    Next
    If carry>0 Then sResult = CStr(carry) & sResult
    'print sResult
    ADD = sResult
  End Function
  
  Private Function Max(a,b)
    If a > b Then
      Max = a
    Else
      Max = b
    End If
  End Function
  
  Private Function pad(a,n)  'pad from right with 0 to length n
    Dim sResult
    sResult = a
    While Len(sResult) < n
      sResult = "0" & sResult
    Wend
    pad = sResult
  End Function
End Class
With that defined I have now all I need to implement a Hex64 function. This I did in two forms:

* A memoized version which precomputes all the relevant powers of 16

Function PrecomputedFromHex64(sHex)
  Dim VLI
  Set VLI = New VeryLongInteger
  
  Dim Sixteen(16)
  Sixteen(0) = "1"
  Sixteen(1) = "16"
  Sixteen(2) = VLI.MULTIPLY(Sixteen(1),"16")
  Sixteen(3) = VLI.MULTIPLY(Sixteen(2),"16")
  Sixteen(4) = VLI.MULTIPLY(Sixteen(3),"16")
  Sixteen(5) = VLI.MULTIPLY(Sixteen(4),"16")
  Sixteen(6) = VLI.MULTIPLY(Sixteen(5),"16")
  Sixteen(7) = VLI.MULTIPLY(Sixteen(6),"16")
  Sixteen(8) = VLI.MULTIPLY(Sixteen(7),"16")
  Sixteen(9) = VLI.MULTIPLY(Sixteen(8),"16")
  Sixteen(10) = VLI.MULTIPLY(Sixteen(9),"16")
  Sixteen(11) = VLI.MULTIPLY(Sixteen(10),"16")
  Sixteen(12) = VLI.MULTIPLY(Sixteen(11),"16")
  Sixteen(13) = VLI.MULTIPLY(Sixteen(12),"16")
  Sixteen(14) = VLI.MULTIPLY(Sixteen(13),"16")
  Sixteen(15) = VLI.MULTIPLY(Sixteen(14),"16")
  
  Dim theAnswer, i, theDigit, theMultiplier, thePower, aPower
  theAnswer = "0"
  aPower = 0
  For i = Len(sHex) To 1 Step -1
    theDigit = UCase(Mid(sHex,i,1))
    theMultiplier = InStr("0123456789ABCDEF",theDigit)-1
    thePower = Sixteen(aPower)
    thePower = VLI.MULTIPLY(CStr(theMultiplier),thePower)
    theAnswer = VLI.ADD(theAnswer,thePower )
    aPower = aPower + 1
  Next
  PrecomputedFromHex64 = theAnswer
End Function
* A non-memoized version which computes the relevant power when it is needed.
Function FromHex64(sHex)
  Dim VLI
  Set VLI = New VeryLongInteger       
  Dim theAnswer, i, theDigit, theMultiplier, thePower, aPower
  theAnswer = "0"
  thePower = "1"
  For i = Len(sHex) To 1 Step -1
    theDigit = UCase(Mid(sHex,i,1))
    theMultiplier = InStr("0123456789ABCDEF",theDigit)-1
    theAnswer = VLI.ADD(theAnswer,VLI.MULTIPLY(thePower,theMultiplier))
    thePower = VLI.MULTIPLY(thePower,"16")
  Next
  FromHex64 = theAnswer
End Function
The memoized version is slightly faster than the non-memoized, despite the overhead of the memoization. If the class/function pair were to be used a lot in a script, one might consider making both the VLI instantiation and the Sixteen() array global and precomputing the array at the beginning of the script rather than on each invocation.

A rough test of the code follows:

Const test = "FFFFFFFFFFFFFFFF" '"41417724EBA8953E"
Dim t, I, S
t=Timer
For I = 1 To 100
  S = FromHex64(test)
Next
WScript.Echo "No memoization", Timer-t

t=Timer
For I = 1 To 100
  S = PrecomputedFromHex64(test)
Next
WScript.Echo "Memoized each time",Timer-t

Function GlobalMemoFromHex64(sHex)  
  Dim theAnswer, i, theDigit, theMultiplier, thePower, aPower
  theAnswer = "0"
  aPower = 0
  For i = Len(sHex) To 1 Step -1
    theDigit = UCase(Mid(sHex,i,1))
    theMultiplier = InStr("0123456789ABCDEF",theDigit)-1
    thePower = Sixteen(aPower)
    thePower = VLI.MULTIPLY(CStr(theMultiplier),thePower)
    theAnswer = VLI.ADD(theAnswer,thePower )
    aPower = aPower + 1
  Next
  GlobalMemoFromHex64 = theAnswer
End Function

Dim VLI
Set VLI = New VeryLongInteger

Dim Sixteen(16)
Sixteen(0) = "1"
Sixteen(1) = "16"
Sixteen(2) = VLI.MULTIPLY(Sixteen(1),"16")
Sixteen(3) = VLI.MULTIPLY(Sixteen(2),"16")
Sixteen(4) = VLI.MULTIPLY(Sixteen(3),"16")
Sixteen(5) = VLI.MULTIPLY(Sixteen(4),"16")
Sixteen(6) = VLI.MULTIPLY(Sixteen(5),"16")
Sixteen(7) = VLI.MULTIPLY(Sixteen(6),"16")
Sixteen(8) = VLI.MULTIPLY(Sixteen(7),"16")
Sixteen(9) = VLI.MULTIPLY(Sixteen(8),"16")
Sixteen(10) = VLI.MULTIPLY(Sixteen(9),"16")
Sixteen(11) = VLI.MULTIPLY(Sixteen(10),"16")
Sixteen(12) = VLI.MULTIPLY(Sixteen(11),"16")
Sixteen(13) = VLI.MULTIPLY(Sixteen(12),"16")
Sixteen(14) = VLI.MULTIPLY(Sixteen(13),"16")
Sixteen(15) = VLI.MULTIPLY(Sixteen(14),"16")

t=Timer
For I = 1 To 100
  S = GlobalMemoFromHex64(test)
Next
WScript.Echo "Global memo",Timer-t
Running the above in VBSEdit a few times under varying conditions gave the following results:
No memoization 2.632813
Memoized each time 1.023438
Global memo 0.328125

No memoization 1.667969
Memoized each time 0.8867188
Global memo 0.2695313

No memoization 1.488281
Memoized each time 0.9335938
Global memo 0.3046875
The global precomputation of the memo array is fastest technique, but if you're only using the function once you'll get by with the non-memo version.

Further optimisations are possible. Compilation, of course, would make it even faster.

Enjoy!
© Copyright Bruce M. Axtens, 2014

No comments: