PureBoard

Code: Alles auswählen

Threaded StrD2_Buffer.s = "                                                                                                    "
Procedure.s StrD2(value.d, nbDecimals.i = 10)
	Protected *c.Character = @StrD2_Buffer + SizeOf(Character) * 50
	Protected.Character *c1 = *c, *c2 = *c, *e = *c - SizeOf(Character)
	Protected d.i, neg.i = Bool(value < 0.0)
	value = Abs(value)
	Protected.d int2, int = Round(value, #PB_Round_Down)
	value - int
	
	; First the part before the digit
	If int > 0.0
		While int >= 1.0
			int2 = Round(int / 10, #PB_Round_Down)
			*c1 - SizeOf(Character)
			*c1\c = '0' + (10 + Int(int - 10.0 * int2) % 10) % 10
			int = int2
		Wend
	Else
		*c1 - SizeOf(Character)
		*c1\c = '0'
	EndIf
	*c1 - SizeOf(Character)
	*c1\c = ' '
	*c1 + SizeOf(Character)
	
	If nbDecimals > 0
		value * 10.0
		
		; Now for the fractional part
		For d = 2 To nbDecimals
			int = Round(value, #PB_Round_Down)
			*c2 + SizeOf(Character)
			*c2\c = '0' + Int(int)
			If *c2\c > '0'
				*e = *c2
			EndIf
			value - int
			value * 10.0
		Next
		int = Round(value, #PB_Round_Nearest)
	Else
		int = Round(value, #PB_Round_Nearest) * 10
	EndIf
	
	; Now the complicated rounding part
	If int < 10.0 ; no carry after rounding
		*c2 + SizeOf(Character)
		*c2\c = '0' + Int(int)
		If *c2\c > '0'
			*e = *c2
		EndIf
	
	Else ;carry
		; set every 9 at the end to 0
		While *c2\c = '9' And *c2 > *c
			*c2\c = '0'
			*c2 - SizeOf(Character)
		Wend
		; increase the non-9 digit by 1
		If *c2 > *c ; if we are still in the fractional part
			*c2\c + 1
			*e = *c2
		
		Else ; if we need to round up the integer part
			*e = *c - SizeOf(Character)
			*c2 = *e
			; again turn the 9 to a 0
			While *c2\c = '9'
				*c2\c = '0'
				*c2 - SizeOf(Character)
			Wend
			; and increase the last remaining non-9 digit by 1
			If *c2\c = ' '
				*c2\c = '1'
				*c1 = *c2
			Else
				*c2\c + 1
			EndIf
		EndIf
	EndIf
	
	; Add a sign if necessary
	If neg
		*c1 - SizeOf(Character)
		*c1\c = '-'
	EndIf
	*c\c = '.'
	
	ProcedureReturn PeekS(*c1, 1 + (*e - *c1) / SizeOf(Character))
EndProcedure

; Prüfstation
Debug ""
Debug "==============================="
Debug "Test certain valued explicitly:"
Define d.i = 16
Define r.d = ValD("0.9847589999999999399449280")

Debug "  12345678901234567890"
Debug r
Debug StrD(r, d)
Debug StrD2(r, d)
;End

; Examples
Debug ""
Debug "==============================="
Debug "Some Examples:"
Debug StrD2(-0.0099890007, 2)
Debug StrD2(-123.4569, 3)
Debug StrD2(9.999, 2)
Debug StrD2(79.999, 2)
Debug StrD2(13.539327, 0)
Debug "10^23 with StrD2: " + StrD2(Pow(11,23), 14)
Debug "10^23 with StrD:  " + StrD(Pow(11,23), 14)

; Test


; change to 2 to actually see the different outcomes

; Mode of operation
; 0: Just made statistics over the defined number of rounds
; 1: The same as 0
; 2: Ignore #ROUNDS and loop until the difference in the last digit is bigger than 0.5 (should be endless)
; 3: Ignore #ROUNDS and loop until the general output differs (can result in differences)
#MODE = 1

; Number of rounds for statistics if #MODE < 2
#ROUNDS = 60000

; Make debuglevel dependent of #MODE
DebugLevel #MODE

Define wins1.i = 0, wins2.i = 0, ties.i = 0
Define var1.d, var2.d, varSum1.d, varSum2.d
Define i.i, s1.s, s2.s, r.d, d.i, r1.d, r2.d
Define realRounds.i

Debug ""
Debug "==============================="
Debug "Looping..."

For i = 1 To #ROUNDS

	realRounds + 1
	; It makes no sense to test for 16+ digits because the mantisse would need more than 52 bits for that
	d = Random(15)
	r = Random(100000000) * 0.000001
	
	s1 = StrD(r, d)
	If FindString(s1, ".")
		s1 = RTrim(RTrim(s1, "0"), ".")
	EndIf
	
	s2 = StrD2(r, d)
	
	If s1 <> s2
		Debug "", 3
		Debug "    r = " + StrD(r, 25), 3
		Debug "    d = " + d, 3
		Debug "StrD  = " + s1, 3
		Debug "StrD2 = " + s2, 3
		r1.d = ValD(s1)
		r2.d = ValD(s2)
		var1 = Abs(r1 - r) * Pow(10, d - 1)
		var2 = Abs(r2 - r) * Pow(10, d - 1)
		Debug StrD(var1, 10) + " | " + StrD(var2, 10), 3
		If var2 - var1 > 0.5
			wins1 + 1
			Debug "StrD  wins! (" + var1 + " < " + var2 + ") => " + StrD(r, 25) + " | " + d, 2
			Debug "StrD  = " + s1, 2
			Debug "StrD2 = " + s2, 2
			If #MODE = 2
				Break
			EndIf
		ElseIf var1 - var2 > 0.5
			wins2 + 1
			Debug "StrD2 wins! (" + var1 + " > " + var2 + ") => " + StrD(r, 25) + " | " + d, 2
			Debug "StrD  = " + s1, 2
			Debug "StrD2 = " + s2, 2
			If #MODE = 2
				Break
			EndIf
		Else
			ties + 1
		EndIf
		If #MODE = 3
			Break
		EndIf
	EndIf
	If #MODE > 1
		i = 0
	EndIf
Next

Debug ""
Debug "==============================="
Debug "ROUNDS = " + realRounds
Debug "Differences: " + Str(wins1 + wins2 + ties)
Debug "Percentage: " + StrD((wins1 + wins2 + ties) * 100.0 / realRounds, 4) + "%"
Debug "StrD  Wins: " + wins1
Debug "StrD2 Wins: " + wins2
Debug "      Ties: " + ties