### Author Topic: IsEqual function  (Read 2132 times)

0 Members and 1 Guest are viewing this topic.

#### Bryco

• Water Moccasin
• Posts: 1851 ##### IsEqual function
« on: March 11, 2006, 10:38:29 AM »
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.

Code: [Select]
`'Paul Marshall http://www.cadvault.com/forums/showthread.php?t=15869&page=4&pp=10Public 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 IfEnd Function'Forgot thisPublic 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
« Last Edit: March 11, 2006, 10:45:50 AM by Bryco »

#### Bob Wahr

• Guest ##### Re: IsEqual function
« Reply #1 on: March 13, 2006, 01:26:32 PM »
am I missing something?
Code: [Select]
`Sub test()Dim dblOne As DoubleDim dblTwo As DoubleDim intOne As IntegerDim booTest As BooleandblOne = 24.586dblTwo = 24.586booTest = SameOrNot(dblOne, dblTwo)Debug.Print "First test result: " & booTestdblOne = 24.586dblTwo = 48.37349booTest = SameOrNot(dblOne, dblTwo)Debug.Print "Second test result: " & booTestdblOne = 24intOne = 24booTest = SameOrNot(dblOne, intOne)Debug.Print "Third test result: " & booTestEnd SubPublic Function SameOrNot(varOne As Variant, varTwo As Variant) As BooleanIf varOne = varTwo Then  SameOrNot = TrueEnd IfEnd Function`

#### Troy Williams

• Guest ##### Re: IsEqual function
« Reply #2 on: March 13, 2006, 02:21:56 PM »
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 = sumEnd FunctionPublic Function RoundIt(ByVal aNumberToRound As Double, Optional ByVal aDecimalPlaces As Double = 0) As DoubleDim nFactor As DoubleDim nTemp As DoublenFactor = 10 ^ aDecimalPlacesnTemp = (aNumberToRound * nFactor) + 0.5RoundIt = Int(CDec(nTemp)) / nFactorEnd 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 booleanif abs(num1 - num2) < tolerance then    ToleranceTest = trueelse   ToleranceTest  = falseendifend function`

#### Bob Wahr

• Guest ##### Re: IsEqual function
« Reply #3 on: March 13, 2006, 07:36:05 PM »
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 BooleanIf Round(varOne, 8) = Round(varTwo, 8) Then  SameOrNot = TrueEnd IfEnd 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

• Water Moccasin
• Posts: 1851 ##### Re: IsEqual function
« Reply #4 on: March 13, 2006, 08:54:09 PM »
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.