Topic: IsEqual function

[Bryco]

Paul wrote/converted  a function for comparing singles in vba in cadvault (the address no longer works but this is close to what he wrote). Since the c languages have larger integers than vba I could never get this to work for doubles and am not too sure it works for singles all the time so I don't use it. The reading is a great article and I suspect someone with a bit of math could come up with a usable function.

'Reading           http://www.cygnus-software.com/papers/comparingfloats/comparingfloats.htm

Code: [Select]

'Paul Marshall http://www.cadvault.com/forums/showthread.php?t=15869&page=4&pp=10
Public Function IsEqual(ByVal A As Single, ByVal B As Single, maxUlps As Long) As Boolean
    ' Make sure maxUlps is non-negative and small enough that the
    ' default NAN won't compare as equal to anything.
    'maxUlps = 5  'I use this
    If Not (maxUlps > 0 And maxUlps < 4& * 1024 * 1024) Then
        Debug.Print "maxUlps out of range"
        Stop
    End If
    Dim aInt As Long 'originally integer
    CopyMemory aInt, A, 4
    ' Make aInt lexicographically ordered as a twos-complement int
    If aInt < 0 Then
        aInt = &H80000000 - aInt
    End If
    ' Make bInt lexicographically ordered as a twos-complement int
    Dim bInt As Long 'originally integer
    CopyMemory bInt, B, 4
    If bInt < 0 Then
        bInt = &H80000000 - bInt
    End If
    ' We need the range of an unsigned Long but
    '   there are no unsigned types available in VB
    '   (other than Byte).
    Dim intDiff As Currency
    intDiff = Abs(CCur(aInt) - bInt)
    Debug.Print A, "Long      " & aInt, bInt, intDiff
    If intDiff <= maxUlps Then
        IsEqual = True
    Else
        IsEqual = False
    End If
End Function

'Forgot this
Public Declare Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" _
    (dest As Any, source As Any, ByVal Length As Long)


What I use now works fine but I'm just fishing for better.
Function Rd(Num1 As Variant, Num2 As Variant) As Boolean
    Dim dRet As Double
    dRet = Num1 - Num2
    If Abs(dRet) < 0.00000001 Then Rd = True
End Function

[Bob Wahr]

am I missing something?

Code: [Select]

Sub test()
Dim dblOne As Double
Dim dblTwo As Double
Dim intOne As Integer
Dim booTest As Boolean
dblOne = 24.586
dblTwo = 24.586
booTest = SameOrNot(dblOne, dblTwo)
Debug.Print "First test result: " & booTest
dblOne = 24.586
dblTwo = 48.37349
booTest = SameOrNot(dblOne, dblTwo)
Debug.Print "Second test result: " & booTest
dblOne = 24
intOne = 24
booTest = SameOrNot(dblOne, intOne)
Debug.Print "Third test result: " & booTest

End Sub

Public Function SameOrNot(varOne As Variant, varTwo As Variant) As Boolean
If varOne = varTwo Then
  SameOrNot = True
End If
End Function


[Troy Williams]

Byrco, I basically use the same approach.

Consider these two routines in excel vba:

Code: [Select]

Public Function VBRoundError(numberOfLoops As Long, Optional Round As Boolean) As Double
    Dim i As Long
    Dim sum As Double
   
    For i = 0 To numberOfLoops
        If Round Then
            sum = RoundIt(sum + 0.01, 7)
        Else
            sum = sum + 0.01
        End If
    Next
   
    VBRoundError = sum
End Function



Public Function RoundIt(ByVal aNumberToRound As Double, Optional ByVal aDecimalPlaces As Double = 0) As Double

Dim nFactor As Double
Dim nTemp As Double

nFactor = 10 ^ aDecimalPlaces
nTemp = (aNumberToRound * nFactor) + 0.5
RoundIt = Int(CDec(nTemp)) / nFactor
End Function


Once you place these routines into a module you can access the VBRoundError function by typing this "=VBRoundError(99)" into a cell.

If I type these into cells within excel:

Code: [Select]

=VBRoundError(99) excel displays 1.000000000000000000
=VBRoundError(999) excel displays  9.999999999999830000
=VBRoundError(9999) excel displays 100.000000000014000000
You can clearly see that there is rounding error taking place. This is just the way that VB/A behaves.

If I use this:

Code: [Select]

=VBRoundError(99,true) excel displays 1.000000000000000000
=VBRoundError(999,true) excel displays  10.000000000000000000
=VBRoundError(9999,true) excel displays 100.000000000000000000

I get nice even values. There really is no way around this because of the way VB/A works.

When working with double or single precision numbers, you should always test using a tolerance or delta value instead of directly comparing two doubles. Here is a routine that I use to test tolerances:

Code: [Select]

public function ToleranceTest(num1 as double, num2 as double, tolerance as double) as boolean

if abs(num1 - num2) < tolerance then
    ToleranceTest = true
else
   ToleranceTest  = false
endif

end function


[Bob Wahr]

Maybe I was missing something if it's a tolerance thing then I was off, if you want a comparison between two numbers I wasn't although if you want to check to 8 decimal places you could do it more like

Code: [Select]

Public Function SameOrNot(varOne As Variant, varTwo As Variant) As Boolean
If Round(varOne, 8) = Round(varTwo, 8) Then
  SameOrNot = True
End If
End Function
If numeric comparison between different types like say doubles and integers was a possibility, you could run a check for an integer if one of them is, round to 0 places.

[Bryco]

Thanks Bob, I have written a polyline join function and without some kind of rounding
you can never get a reliable reading of 0 0r 90 deg or 0 or 0.5* pi.
Stepping through the routine involves 1000's of calls to my sub Rd, it drives me nuts.
Troy, thanks for the post. Your ToleranceTest is virtually the same as mine although it wont accept single or integers so I went for the hungry variants.
The cool part about the article is using Rd or Round doesn't work so well for very large numbers or very small numbers and it comes up with a very good method to facilitate most circumstances.