some procedures for fractional arithmetic
Posted: Mon Jan 12, 2004 8:15 am
Code updated For 5.20+
Hi, here are some procedures for doing fractional arithmetic.
This gives you much more accuracy than even doubles in the most used range +/- 2^-31 upto +/- 2^31. You can handle nearly any rational number in this range exactly and do basic calculations on them without ANY loss of precision.
[edit]just replaced GlobalAlloc_ with the new AllocateMemory[/edit]
Hi, here are some procedures for doing fractional arithmetic.
This gives you much more accuracy than even doubles in the most used range +/- 2^-31 upto +/- 2^31. You can handle nearly any rational number in this range exactly and do basic calculations on them without ANY loss of precision.
[edit]just replaced GlobalAlloc_ with the new AllocateMemory[/edit]
Code: Select all
;- some procedures to calculate with fractions
;- 12.01.04 by Froggerprogger
;-
;- keep in mind the denominator must never be zero - if it is, the Fraction_GetStr() returns 'Division by 0'
;-
;- GCD = Greatest Common Divisor
;- LCM = Lowest Common Multiple
;- the main structure used by the procedures
Structure Fraction
nom.l
denom.l
EndStructure
;- some help-procedures needed by the main-procedures
Procedure.l AbsL(p_int.l)
If p_int > 0
ProcedureReturn p_int
Else
ProcedureReturn 0 - p_int
EndIf
EndProcedure
Procedure.l SgnL(p_int.l)
If p_int > 0
ProcedureReturn 1
ElseIf p_int < 0
ProcedureReturn -1
Else
ProcedureReturn 0
EndIf
EndProcedure
Procedure.l RoundReal(p_val.f)
If p_val = 0
ProcedureReturn 0
ElseIf p_val > 0
If p_val - Int(p_val) >= 0.5
ProcedureReturn Int(p_val) + 1
Else
ProcedureReturn Int(p_val)
EndIf
Else
If p_val - Int(p_val) <= -0.5
ProcedureReturn Int(p_val) - 1
Else
ProcedureReturn Int(p_val)
EndIf
EndIf
EndProcedure
Procedure.l GetGCD(p_int1.l, p_int2.l)
Protected i.l
If p_int1 = 0 Or p_int2 = 0
ProcedureReturn 0
EndIf
p_int1 = AbsL(p_int1)
p_int2 = AbsL(p_int2)
If p_int1 < p_int2 ; swap the values
i = p_int2
p_int2 = p_int1
p_int1 = i
EndIf
If p_int1 % p_int2 = 0
ProcedureReturn p_int2
EndIf
i = Int(p_int2)/2
While i > 1 And (p_int2 % i <> 0 Or p_int1 % i <> 0)
i - 1
Wend
ProcedureReturn i
EndProcedure
Procedure.l GetLCM(p_int1.l, p_int2.l)
Protected i.l
If p_int1 = 0 Or p_int2 = 0
ProcedureReturn 0
EndIf
p_int1 = AbsL(p_int1)
p_int2 = AbsL(p_int2)
If p_int1 < p_int2 ; swap the values
i = p_int2
p_int2 = p_int1
p_int1 = i
EndIf
i=1
While (i * p_int2) % p_int1 <> 0
i + 1
Wend
ProcedureReturn i * p_int2
EndProcedure
;- the main-procedures for the calculations, I think they're self-explaining
;- Nearly all return a pointer to the calculation's result, that is stored in
;- the first overgiven fraction-parameter, too.
;- you might keep the orignal value by using Fraction_GetCopy() inside the
;- procedure-call, see the examples.
Procedure.s Fraction_GetStr(*p_f.Fraction)
If *p_f\denom = 0
ProcedureReturn "Division by 0"
Else
ProcedureReturn Str(*p_f\nom)+" / "+Str(*p_f\denom)
EndIf
EndProcedure
Procedure.s Fraction_GetStrMixedNumber(*p_f.Fraction)
If *p_f\denom = 0
ProcedureReturn "Division by 0"
ElseIf *p_f\nom > *p_f\denom
ProcedureReturn Str(Int(*p_f\nom / *p_f\denom)) + " _ " + Str(*p_f\nom % *p_f\denom)+" / "+Str(*p_f\denom)
Else
ProcedureReturn Str(*p_f\nom % *p_f\denom)+" / "+Str(*p_f\denom)
EndIf
EndProcedure
Procedure.l Fraction_Create(p_nom.l, p_denom.l)
Protected *p_res.Fraction
*p_res = AllocateMemory(SizeOf(Fraction))
*p_res\nom = p_nom
*p_res\denom = p_denom
ProcedureReturn *p_res
EndProcedure
Procedure.l Fraction_CreateMixedNumber(p_int.l, p_nom.l, p_denom.l)
Protected *p_res.Fraction
*p_res = AllocateMemory(SizeOf(Fraction))
*p_res\nom = p_nom + p_int * p_denom
*p_res\denom = p_denom
ProcedureReturn *p_res
EndProcedure
Procedure.l Fraction_Free(*p_f.Fraction)
If GlobalFree_(*p_f) = 0 ; returning 0 means all is OK - Memory freed
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure.l Fraction_SetData(*p_f.Fraction, p_nom.l, p_denom.l)
*p_f\nom = p_nom
*p_f\denom = p_denom
ProcedureReturn *p_f
EndProcedure
Procedure.l Fraction_SetDataMixedNumber(*p_f.Fraction, p_int.l, p_nom.l, p_denom.l)
*p_f\nom = p_nom + p_int * p_denom
*p_f\denom = p_denom
ProcedureReturn *p_f
EndProcedure
Procedure.l Fraction_GetCopy(*p_f.Fraction)
Protected *p_res
*p_res = AllocateMemory(SizeOf(Fraction))
CopyMemory(*p_f, *p_res, SizeOf(Fraction))
ProcedureReturn *p_res
EndProcedure
Procedure.l Fraction_CopyTo(*p_f1.Fraction, *p_f2.Fraction)
*p_f1\nom = *p_f2\nom
*p_f1\denom = *p_f2\denom
ProcedureReturn *p_f1
EndProcedure
Procedure.l Fraction_Reduce(*p_f.Fraction)
Protected ggt.l
ggt = GetGCD(*p_f\nom, *p_f\denom)
If ggt > 1
*p_f\nom / ggt
*p_f\denom / ggt
EndIf
If *p_f\denom < 0
*p_f\nom * -1
*p_f\denom * -1
EndIf
ProcedureReturn *p_f
EndProcedure
Procedure.l Fraction_Extend(*p_f.Fraction, p_int.l)
*p_f\nom * p_int
*p_f\denom * p_int
ProcedureReturn *p_f
EndProcedure
Procedure.l Fraction_Reciprocal(*p_f1.Fraction)
Protected temp.l
temp = *p_f1\denom
*p_f1\denom = *p_f1\nom
*p_f1\nom = temp
ProcedureReturn *p_f1
EndProcedure
Procedure.l Fraction_Add(*p_f1.Fraction, *p_f2.Fraction)
If *p_f1\denom <> *p_f2\denom
Fraction_Reduce(*p_f1)
Fraction_Reduce(*p_f2)
Protected kgv.l
kgv = GetLCM(*p_f1\denom, *p_f2\denom)
If kgv > 1
Fraction_Extend(*p_f1, kgv/*p_f1\denom)
Fraction_Extend(*p_f2, kgv/*p_f2\denom)
EndIf
EndIf
*p_f1\nom + *p_f2\nom
ProcedureReturn Fraction_Reduce(*p_f1)
EndProcedure
Procedure.l Fraction_Add_L(*p_f1.Fraction, p_int.l)
*p_f1\nom + p_int * *p_f1\denom
ProcedureReturn Fraction_Reduce(*p_f1)
EndProcedure
Procedure.l Fraction_Sub(*p_f1.Fraction, *p_f2.Fraction)
If *p_f1\denom <> *p_f2\denom
Fraction_Reduce(*p_f1)
Fraction_Reduce(*p_f2)
Protected kgv.l
kgv = GetLCM(*p_f1\denom, *p_f2\denom)
If kgv > 1
Fraction_Extend(*p_f1, kgv/*p_f1\denom)
Fraction_Extend(*p_f2, kgv/*p_f2\denom)
EndIf
EndIf
*p_f1\nom - *p_f2\nom
ProcedureReturn Fraction_Reduce(*p_f1)
EndProcedure
Procedure.l Fraction_Sub_L(*p_f1.Fraction, p_int.l)
*p_f1\nom - p_int * *p_f1\denom
ProcedureReturn Fraction_Reduce(*p_f1)
EndProcedure
Procedure.l Fraction_Mul(*p_f1.Fraction, *p_f2.Fraction)
Fraction_Reduce(*p_f1)
Fraction_Reduce(*p_f2)
*p_f1\nom * *p_f2\nom
*p_f1\denom * *p_f2\denom
ProcedureReturn Fraction_Reduce(*p_f1)
EndProcedure
Procedure.l Fraction_Mul_L(*p_f1.Fraction, p_int.l)
Fraction_Reduce(*p_f1)
*p_f1\nom * p_int
ProcedureReturn Fraction_Reduce(*p_f1)
EndProcedure
Procedure.l Fraction_Div(*p_f1.Fraction, *p_f2.Fraction)
Fraction_Reduce(*p_f1)
Fraction_Reduce(*p_f2)
*p_f1\nom * *p_f2\denom
*p_f1\denom * *p_f2\nom
ProcedureReturn Fraction_Reduce(*p_f1)
EndProcedure
Procedure.l Fraction_Div_L(*p_f1.Fraction, p_int.l)
Fraction_Reduce(*p_f1)
*p_f1\denom * p_int
ProcedureReturn Fraction_Reduce(*p_f1)
EndProcedure
Procedure.l Fraction_Pow(*p_f1.Fraction, p_power.l)
Fraction_Reduce(*p_f1)
If p_power < 0
p_power * -1
Fraction_Reciprocal(*p_f1)
EndIf
If p_power = 0
*p_f1\nom = 1
*p_f1\denom = 1
ProcedureReturn *p_f1
ElseIf p_power = 1
ProcedureReturn *p_f1
Else
Protected *p_f2.Fraction
*p_f2 = Fraction_GetCopy(*p_f1)
For i=2 To p_power
Fraction_Mul(*p_f2, *p_f1)
Next
Fraction_CopyTo(*p_f1, *p_f2)
Fraction_Free(*p_f2)
ProcedureReturn Fraction_Reduce(*p_f1)
EndIf
EndProcedure
Procedure.f Fraction_GetVal_F(*p_f.Fraction)
If *p_f\denom = 0
ProcedureReturn $7FFFFFFF
Else
ProcedureReturn *p_f\nom / *p_f\denom
EndIf
EndProcedure
Procedure.l Fraction_GetVal_L(*p_f.Fraction)
If *p_f\denom = 0
ProcedureReturn $7FFFFFFF
Else
ProcedureReturn RoundReal(*p_f\nom / *p_f\denom)
EndIf
EndProcedure
;-
;- some examples
;-
Debug "Just some examples:"
*a = Fraction_CreateMixedNumber(3, 5, 8)
*b = Fraction_Create(12, 1)
Debug "a = " + Fraction_GetStrMixedNumber(*a) + " = " + Fraction_GetStr(*a)
Debug "b = " + Fraction_GetStrMixedNumber(*b) + " = " + Fraction_GetStr(*b)
*c = Fraction_Sub(Fraction_GetCopy(*a), *b) ; *c is created by Fraction_GetCopy
Debug "a - b = " + Fraction_GetStr(*c)
Fraction_Free(*c) ; all variables will be automatically freed after program end, too
; however, in some cases inside loops using Fraction_GetCopy() you should use it, if
; you don't need it anymore
*d = Fraction_GetCopy(*a)
Fraction_Mul(*d, *b)
Debug "a * b = " + Fraction_GetStr(*d)
Debug "(a * b) ^ 4 = " + Fraction_GetStrMixedNumber(Fraction_Pow(*c, 4))
Debug ""
;to get direct access to the nominator / denominator create it with 'myName.Fraction'
*e.Fraction = Fraction_GetCopy(*a)
Debug "a = " + Str(*e\nom) + " / " + Str(*e\denom)
Fraction_Extend(*e, 3)
Debug "a = " + Fraction_GetStr(*e)
Debug "a = " + StrF(Fraction_GetVal_F(*e))
Fraction_SetData(*e, 3, 0)
Debug "(a = 3/0) -> a = " + Fraction_GetStr(*e)