Da es letztens Thema war, habe ich mal den Kahan-Algorithmus implementiert, welcher die binären Rundungsfehler bei der Summation von Gleitkommazahlen minimiert.
Dazu gibt es auch eine normale _ArraySum()-Funktion, einfach weil eine solche bislang nicht mitgeliefert wird:
AutoIt
Global $aValues = [1, 1e100, 1, -1e100]
$fSum = _ArraySum($aValues)
ConsoleWrite(StringFormat("% 15s: %.20g\t(%d values)\n", "naive sum", $fSum, @extended))
$fSum = _ArraySumPrecise($aValues)
ConsoleWrite(StringFormat("% 15s: %.20g\t(%d values)\n\n", "Neumaier sum", $fSum, @extended))
; #FUNCTION# ====================================================================================================================
; Name ..........: _ArraySum()
; Description ...: calculates the sum over a 1D array, a map or a column of a 2D array
; Syntax ........: _ArraySum($aValues, [$iFrom = 0, [$iTo = Default, [$iCol = 0]]])
; Parameters ....: aValues - [Array] 1D/2D array or map
; iFrom - [Int] (Default: 0)
; ↳ start index (0-based)
; iTo - [Int] (Default: Default)
; ↳ end index (0-based)
; iCol - [Int] (Default: 0)
; ↳ 2D array case: column over which the sum is to be calculated
; Return value ..: Success: SetError(2, UBound($aValues, 0), Null)
; Failure: Null and set @error to:
; | 1: invalid data type for $aValues
; | 2: $aValues is not a 1D or 2D array (@extended: number of dimension of $aValues)
; | 3: invalid value for $iFrom (@extended: number of elements in the array[-column])
; | 4: invalid value for $iTo (@extended: number of elements in the array[-column])
; | 5: invalid value for $iCol (@extended: number of columns in the array)
; Author ........: AspirinJunkie
; Modified.......: 2024-09-02
; Example .......: Yes
; $aValues = [1, 2, 3, 4, 5]
; $fSum = _ArraySum($aValues)
; ConsoleWrite(StringFormat("% 5s: %.20g\t(%d values)\n", "sum", $fSum, @extended))
; ===============================================================================================================================
Func _ArraySum($aValues, Const $iFrom = 0, $iTo = Default, Const $iCol = 0)
Local $i
Local $fSum = 0.0
; convert map values into 1D-Array
If IsMap($aValues) Then
Local $aTmp[UBound($aValues)]
$i = 0
For $fVal In $aValues
$aTmp[$i] = $fVal
$i += 1
Next
$aValues = $aTmp
EndIf
; retrieve main shape values
Local $iD = UBound($aValues, 0), _
$iM = UBound($aValues, 1)
If IsKeyword($iTo) = 1 Then $iTo = $iM - 1
; check parameters for correctness
If Not IsArray($aValues) Then Return SetError(1, 0, Null)
If $iFrom < 0 Or $iFrom >= $iM Then Return SetError(3, $iM, Null)
If $iTo >= $iM Or $iFrom > $iTo Then Return SetError(4, $iM, Null)
If $iD = 1 Then ; 1D-Array
For $i = $iFrom To $iTo
$fSum += $aValues[$i]
Next
ElseIf $iD = 2 Then ; 2D-Array
Local $iN = UBound($aValues, 2)
If $iN >= $iCol Or $iCol < 0 Then Return SetError(5, $iN, Null)
For $i = $iFrom To $iTo
$fSum += $aValues[$i][$iCol]
Next
Else
Return SetError(2, UBound($aValues, 0), Null)
EndIf
Return SetExtended($iTo - $iFrom + 1, $fSum)
EndFunc
; #FUNCTION# ====================================================================================================================
; Name ..........: _ArraySumPrecise()
; Description ...: calculates the sum over a 1D array, a map or a column of a 2D array
; and minimises the binary rounding error that occurs
; Syntax ........: _ArraySumPrecise($aValues, [$iFrom = 0, [$iTo = Default, [$iCol = 0]]])
; Parameters ....: aValues - [Array] 1D/2D array or map
; iFrom - [Int] (Default: 0)
; ↳ start index (0-based)
; iTo - [Int] (Default: Default)
; ↳ end index (0-based)
; iCol - [Int] (Default: 0)
; ↳ 2D array case: column over which the sum is to be calculated
; Return value ..: Success: SetError(2, UBound($aValues, 0), Null)
; Failure: Null and set @error to:
; | 1: invalid data type for $aValues
; | 2: $aValues is not a 1D or 2D array (@extended: number of dimension of $aValues)
; | 3: invalid value for $iFrom (@extended: number of elements in the array[-column])
; | 4: invalid value for $iTo (@extended: number of elements in the array[-column])
; | 5: invalid value for $iCol (@extended: number of columns in the array)
; Author ........: AspirinJunkie
; Modified.......: 2024-09-02
; Remarks .......: The function implements Neumaier's "improved Kahan-Babuška algorithm". Basically the 1:1 translation of the pseudo code on Wikipedia.
; Link ..........: https://en.wikipedia.org/wiki/Kahan_summation_algorithm#Further_enhancements
; Example .......: Yes
; $aValues = [1, 2, 3, 4, 5]
; $fSum = _ArraySumPrecise($aValues)
; ConsoleWrite(StringFormat("% 5s: %.20g\t(%d values)\n", "sum", $fSum, @extended))
; ===============================================================================================================================
Func _ArraySumPrecise($aValues, Const $iFrom = 0, $iTo = Default, Const $iCol = 0)
Local $i
Local $fSum = 0.0, $fC = 0.0, $fT
; convert map values into 1D-Array
If IsMap($aValues) Then
Local $aTmp[UBound($aValues)]
$i = 0
For $fVal In $aValues
$aTmp[$i] = $fVal
$i += 1
Next
$aValues = $aTmp
EndIf
; retrieve main shape values
Local $iD = UBound($aValues, 0), _
$iM = UBound($aValues, 1)
If IsKeyword($iTo) = 1 Then $iTo = $iM - 1
; check parameters for correctness
If Not IsArray($aValues) Then Return SetError(1, 0, Null)
If $iFrom < 0 Or $iFrom >= $iM Then Return SetError(3, $iM, Null)
If $iTo >= $iM Or $iFrom > $iTo Then Return SetError(4, $iM, Null)
If $iD = 1 Then ; 1D-Array
For $i = $iFrom To $iTo
$fT = $fSum + $aValues[$i]
$fC += Abs($fSum) >= Abs($aValues[$i]) _
? $fSum - $fT + $aValues[$i] _
: $aValues[$i] - $fT + $fSum
$fSum = $fT
Next
ElseIf $iD = 2 Then ; 2D-Array
Local $iN = UBound($aValues, 2)
If $iN >= $iCol Or $iCol < 0 Then Return SetError(5, $iN, Null)
For $i = $iFrom To $iTo
$fT = $fSum + $aValues[$i][$iCol]
$fC += Abs($fSum) >= Abs($aValues[$i][$iCol]) _
? $fSum - $fT + $aValues[$i][$iCol] _
: $aValues[$i][$iCol] - $fT + $fSum
$fSum = $fT
Next
Else
Return SetError(2, UBound($aValues, 0), Null)
EndIf
Return SetExtended($iTo - $iFrom + 1, $fSum + $fC)
EndFunc
Alles anzeigen