AW: Korrektur
25.04.2020 11:30:23
Sulprobil
Hallo Luc,
Danke für Deine Fehlermeldung. Die Konstante muss korrigiert werden.
Die Zellabhängigkeit sollte man bei dieser Art Funktion wohl ganz herausnehmen.
Dem Rest Deiner "Prosa" kann ich leider nicht zustimmen :-)
Hier meine Korrektur:
Option Explicit
#If Win64 Then
Function sbNRN(dFloat As Double, lMaxDen As LongLong, _
Optional dMaxErr As Double = -1#) As Variant
#Else
Function sbNRN(dFloat As Double, lMaxDen As Long, _
Optional dMaxErr As Double = -1#) As Variant
#End If
'Computes nearest rational number to dFloat with a maximal denominator
'lMaxDen and a maximal absolute error dMaxErr and returns result as a
'variant Nominator / Denominator.
'See: Oliver Aberth, A method for exact computation with rational numbers,
' JCAM, vol 4, no. 4, 1978
'Reverse(moc.liborplus.www) V1.2 25-Apr-2020
Dim dB As Double
#If Win64 Then
Dim lA As LongLong, lSgn As LongLong
Dim lP1 As LongLong, lP2 As LongLong, lP3 As LongLong
Dim lQ1 As LongLong, lQ2 As LongLong, lQ3 As LongLong
#Else
Dim lA As Long, lSgn As Long
Dim lP1 As Long, lP2 As Long, lP3 As Long
Dim lQ1 As Long, lQ2 As Long, lQ3 As Long
#End If
If dMaxErr = -1# Then dMaxErr = 1# / (2# * CDbl(lMaxDen) ^ 2#)
lSgn = Sgn(dFloat): dB = Abs(dFloat)
lP1 = 0: lP2 = 1: lQ1 = 1: lQ2 = 0
Do While lMaxDen > lQ2
lA = Int(dB)
lP3 = lA * lP2 + lP1: lQ3 = lA * lQ2 + lQ1
#If Win64 Then
If Abs(dB - CDbl(lA)) lMaxDen Then
lQ3 = lQ2: lP3 = lP2
If lQ2 > lMaxDen Then
lQ3 = lQ1: lP3 = lP1
End If
End If
'If absolute error exceeds 1/2Q^2 then Aberth's lemma p. 286 might not apply.
'But the user can override this and check the result himself.
If Abs(dFloat - lSgn * lP3 / lQ3) > dMaxErr Then
sbNRN = CVErr(xlErrNum)
Else
sbNRN = Array(lSgn * lP3, lQ3)
End If
End Function
Viele Grüße,
Bernd P