Navigation
Install the app
How to install the app on iOS
Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
More options
-
Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
You are using an out of date browser. It may not display this or other websites correctly.
You should upgrade or use an alternative browser.
You should upgrade or use an alternative browser.
How to calculate with more precision
String Commands
How to calculate with more precision
by
Olaf Doschke
Posted
(Edited
)
This string math library can be used for predictable precision arithmetic for base operations Add/Subtract/Multiply/Divide.
For usage see the sample code before Define Class. You may configure a higher precision via the gnPrecision constant. This only applies to DivideStr(), all other operations are done with exact precision (limited by nothing but the finite nature of strings and of course VFPs 2GB RAM limit). Calculations involving divisions in several places obviously can be more wrong than just by the rounded precision. Errors of intermediate results are propagated in case, so adjust your formulas to divide last, if possible.
The library is not in a performance optimized state. Don't use in production, please, don't use with mass data. This class is given as is with no warranties.
For usage see the sample code before Define Class. You may configure a higher precision via the gnPrecision constant. This only applies to DivideStr(), all other operations are done with exact precision (limited by nothing but the finite nature of strings and of course VFPs 2GB RAM limit). Calculations involving divisions in several places obviously can be more wrong than just by the rounded precision. Errors of intermediate results are propagated in case, so adjust your formulas to divide last, if possible.
The library is not in a performance optimized state. Don't use in production, please, don't use with mass data. This class is given as is with no warranties.
Code:
Clear
Set Decimals To 18
Set Fixed Off
Local loMath As StringMath
loMath = Createobject("StringMath")
? loMath.AddStr ("13432677809007654432423","-454354354357432"),;
13432677809007654432423-454354354357432
? loMath.SubtractStr("13432677809007654432423", "454354354357432"),;
13432677809007654432423-454354354357432
? loMath.MultiplyStr("2223123213.12783","10010212.23412"),;
2223123213.12783*10010212.23412
? loMath.DivideStr ("32123123213","17810212867"),;
32123123213/17810212867
? loMath.DivideStr ("265.96","20"),;
FLOOR(1000000*265.96/20)/1000000
Define Class StringMath As Custom
#Define gnPrecision 30
Protected o1 && operand 1 (for any operation Add, Subtract, Multiply and Divide)
Protected o2 && operand 2
o1 = .Null. && init NULL
o2 = .Null.
Procedure AddStr() && adding two numbers
Lparameters tc1,tc2
* Initing the two operands to empty objects
This.o1 = Createobject("empty")
This.o2 = Createobject("empty")
* Parsing the number strings into some object prpoerties
* (eg length, number of decimal places)
This.Parse(tc1, This.o1)
This.Parse(tc2, This.o2)
* Prepare operands for the Sum Operation
*(same preparation for other operations, too, therefore an own Method (DRY))
This.AlignOperands(This.o1, This.o2)
* calculate sum
Return This.OparandsSum()
Endproc
Procedure SubtractStr()
Lparameters tc1,tc2
This.o1 = Createobject("empty")
This.o2 = Createobject("empty")
This.Parse(tc1, This.o1)
This.Parse(tc2, This.o2)
This.AlignOperands(This.o1, This.o2)
* Just invert the sign of the second operand
* to be able to use the sum operation, again
This.o2.Sign = Chrtran(This.o2.Sign,"+-","-+")
Return This.OparandsSum()
Endproc
Procedure MultiplyStr()
Lparameters tc1,tc2
This.o1 = Createobject("empty")
This.o2 = Createobject("empty")
This.Parse(tc1, This.o1)
This.Parse(tc2, This.o2)
This.AlignOperands(This.o1, This.o2)
Return This.OperandsProduct()
Endproc
Procedure DivideStr()
Lparameters tc1,tc2
This.o1 = Createobject("empty")
This.o2 = Createobject("empty")
This.Parse(tc1, This.o1)
This.Parse(tc2, This.o2)
* Different alignment for the follow up Quotient operation
This.AlignOperandsForDivision(This.o1, This.o2)
Return This.OperandsQuotient()
Endproc
* Protected methods, ie code only needed internally
Protected Procedure OparandsSum()
Local lcResult, lcResultSign, lnDecimals
lnDecimals = This.o1.Decimals
If This.o1.Sign == This.o2.Sign
lcResultSign = Chrtran(This.o1.Sign,"+","")
lcResult = This.StringsSum(This.o1.digits, This.o2.digits, 1)
Else
Do Case
Case This.o1.digits>This.o2.digits
lcResultSign = Chrtran(This.o1.Sign,"+","")
lcResult = This.StringsSum(This.o1.digits, This.o2.digits, -1)
Case This.o2.digits>This.o1.digits
lcResultSign = Chrtran(This.o2.Sign,"+","")
lcResult = This.StringsSum(This.o2.digits, This.o1.digits, -1)
Otherwise
lcResultSign = ""
lcResult = "0"
lnDecimals = 0
Endcase
Endif
lcResult = Left(lcResult,Len(lcResult)-lnDecimals)+;
Iif(lnDecimals>0,".","")+Right(lcResult,lnDecimals)
Return This.Normalise(lcResultSign,lcResult)
Endproc
Protected Procedure OperandsProduct()
Local lcResultSign, lcResult, lcTempResult, lnLength,;
lnCount1, lnCount2, lnDigit, lnDigit2
* Digits and length are the same for both operand1 o1
* and operand2 o2 because of the initial alignment
lnDecimals = This.o1.Decimals
lnLength = Len(This.o1.digits)
Local Array laTempResult[9]
Store "" To laTempResult
lcResult = "0"
lcResultSign = Iif(This.o1.Sign=This.o2.Sign,"","-")
For lnCount2 = lnLength To 1 Step -1
lnDigit2 = Val(Substr(This.o2.digits,lnCount2,1))
Do Case
Case lnDigit2=0
lcTempResult = "0"
Case lnDigit2=1
lcTempResult = This.o1.digits
Case !Empty(laTempResult[lnDigit2])
lcTempResult = laTempResult[lnDigit2]
Otherwise
lcTempResult = ""
lnCarry = 0
For lnCount1 = lnLength To 1 Step -1
lnDigit = Val(Substr(This.o1.digits,lnCount1,1))*lnDigit2+lnCarry
If lnCount1>1
lcTempResult = Transform(lnDigit%10)+lcTempResult
lnCarry = Floor(lnDigit/10)
Else
lcTempResult = Transform(lnDigit)+lcTempResult
Endif
Endfor
laTempResult[lnDigit2]=lcTempResult
Endcase
lcTempResult = lcTempResult+Replicate("0",lnLength-lnCount2)
If Len(lcTempResult)>Len(lcResult)
lcResult = Replicate("0",Len(lcTempResult)-Len(lcResult))+lcResult
Else
lcTempResult = Replicate("0",Len(lcResult)-Len(lcTempResult))+lcTempResult
Endif
lcResult = This.StringsSum(lcResult,lcTempResult,1)
Endfor
lcResult = Left(lcResult,Len(lcResult)-2*lnDecimals)+;
Iif(lnDecimals>0,".","")+Right(lcResult,2*lnDecimals)
Return This.Normalise(lcResultSign,lcResult)
Endproc
Protected Procedure OperandsQuotient()
Local lcResult, lcResultSign, lcDivisor, lcDividend, lnDigit, lcZero, lcMultiple
Local Array laMultiples[9]
Store "" To laMultiples
lnDecimal = This.o2.Decimals
lcResult = ""
If lnDecimal<0
lcResult = "."+Replicate("0",-lnDecimal-1)
Else
lcResult = ""
Endif
lcResultSign = Iif(This.o1.Sign=This.o2.Sign,"","-")
lcDivisor = This.o1.digits
lcDividend = This.o2.digits
laMultiples[1] = lcDividend
lcMultiple = laMultiples[1]
For lnDigit = 2 To 9
If Len(laMultiples[lnDigit-1])>Len(lcMultiple)
lcMultiple = Replicate("0",Len(laMultiples[lnDigit-1])-Len(lcMultiple))+lcMultiple
Endif
laMultiples[lnDigit] = This.StringsSum(laMultiples[lnDigit-1],lcMultiple,1)
Endfor
Do While lnDecimal>-gnPrecision-2
lcZero = ""
Do While lnDecimal>-gnPrecision-2 And (Len(lcDivisor)<Len(lcDividend) ;
Or (Len(lcDivisor)=Len(lcDividend) And lcDivisor<lcDividend))
lcDivisor = lcDivisor + "0"
lnDecimal = lnDecimal - 1
If lnDecimal = -1
lcResult = lcResult + "."
Endif
lcResult = lcResult + lcZero
lcZero = "0"
Enddo
If lnDecimal>-gnPrecision-2
lcDigit = "0"
lcSubtract = Replicate("0",Len(lcDivisor))
For lnDigit = 9 To 1 Step -1
If Len(laMultiples[lnDigit])<=Len(lcDivisor) And ;
Padl(laMultiples[lnDigit],Len(lcDivisor),"0")<=lcDivisor
lcDigit = Transform(lnDigit)
lcSubtract = Padl(laMultiples[lnDigit],Len(lcDivisor),"0")
Exit
Endif
Endfor
lcDivisor = Ltrim(This.StringsSum(lcDivisor, lcSubtract,-1),0,"0")
lcResult = lcResult + lcDigit
Endif
Enddo
If Right(lcResult,1)>="5"
lcResult = This.StringInc(Left(lcResult,Len(lcResult)-1))
Else
lcResult = Left(lcResult,Len(lcResult)-1)
Endif
Return This.Normalise(lcResultSign,lcResult)
Endproc
Protected Procedure StringsSum()
Lparameters tc1,tc2,tnSign && tnSign=1:add, tnSign=-1:subtract
Local lcResult, lnCarry
lcResult = ""
lnCarry = 0
For lnCount = Len(tc1) To 1 Step -1
lnDigit = Val(Substr(tc1,lnCount,1))+tnSign*Val(Substr(tc2,lnCount,1))+lnCarry
If lnCount>1
lcResult = Transform(lnDigit%10)+lcResult
lnCarry = Floor(lnDigit/10)
Else
lcResult = Transform(lnDigit)+lcResult
Endif
Endfor
Return lcResult
Endproc
Protected Procedure StringInc()
Lparameters tc1
Local lcResult, lnCarry
lcResult = ""
lnCarry = 1 && increment by 1 via initial Carry Over = 1
For lnCount = Len(tc1) To 1 Step -1
lnDigit = Val(Substr(tc1,lnCount,1))+lnCarry
If lnCount>1
lcResult = Transform(lnDigit%10)+lcResult
lnCarry = Floor(lnDigit/10)
If lnCarry=0
lcResult = Left(tc1,lnCount-1)+lcResult
Exit
Endif
Else
lcResult = Transform(lnDigit)+lcResult
Endif
Endfor
Return lcResult
Endproc
Protected Procedure Parse(tcNum, toNum)
If Vartype(tcNum)="N"
tcNum = Transform(tcNum)
Do Case
Case Left(tcNum,2)=="0."
tcNum = Substr(tcNum,2)
Case Left(tcNum,3)=="-0."
tcNum = "-"+Substr(tcNum,3)
Endcase
Endif
If Empty(tcNum)
Error "Can't calculate with empty value of type "+Vartype(tcNum)
Else
If !Vartype(tcNum)="C"
Error "Can't calculate with non string value "+Transform(tcNum)
Endif
Endif
AddProperty(toNum,"sign",Iif(Left(tcNum,1)="-","-","+"))
AddProperty(toNum,"decimals",Len(tcNum)-Evl(At(".",tcNum),Len(tcNum)))
AddProperty(toNum,"digits",Chrtran(tcNum,Chrtran(tcNum,"0123456789",""),""))
If !(Alltrim(Ltrim(tcNum,0,"-","+"),0,"0") == Alltrim(Left(toNum.digits,Len(toNum.digits)-toNum.Decimals)+;
Iif(toNum.Decimals>0,".","")+Right(toNum.digits,toNum.Decimals),0,"0"))
Error tcNum+" is not a valid string number"
Endif
Endproc
Protected Procedure AlignOperands()
Lparameters to1, to2
* align number of decimal places (add trailing zeros)
Do Case
Case to1.Decimals<to2.Decimals
to1.digits = to1.digits+Replicate("0",to2.Decimals-to1.Decimals)
to1.Decimals = to2.Decimals
Case to1.Decimals>to2.Decimals
to2.digits = to2.digits+Replicate("0",to1.Decimals-to2.Decimals)
to2.Decimals = to1.Decimals
Endcase
* align overall length (add leading zeros)
Local lnLength
lnLength = Max(Len(to1.digits),Len(to2.digits))
If Len(to1.digits)<lnLength
to1.digits=Replicate("0",lnLength-Len(to1.digits))+to1.digits
Endif
If Len(to2.digits)<lnLength
to2.digits=Replicate("0",lnLength-Len(to2.digits))+to2.digits
Endif
Endproc
Protected Procedure AlignOperandsForDivision()
Lparameters to1, to2
* Alignment of decimal places and overall length
* Turn division to a pure integer division by padding with 0
Local lcMissingDecimals
lcMissingDecimals = Replicate("0",Abs(to1.Decimals-to2.Decimals))
Do Case
Case to1.Decimals<to2.Decimals
to1.digits=to1.digits+lcMissingDecimals
Case to2.Decimals<to1.Decimals
to2.digits=to2.digits+lcMissingDecimals
Endcase
* Decimal places now are equalized, they don't matter anymore,
* ie we can think of an integer division of to1.digits/to2.digits
to1.Decimals = 0
to2.Decimals = 0
* Now we still may have it easier by shifting one of the numbers:
lnShift = Len(to1.digits)-Len(to2.digits)
* If lnShift>0 to2.digits is padded right with "0" and the result
* is factored (shifted) by that amount of digits
* Also when there are leading zeroes (eg 0.00x became 000x,
* those zeros now are unwanted)
Do While Left(to1.digits,1)=="0"
to1.digits = Substr(to1.digits,2)
lnShift = lnShift - 1 && later add less zeroes to to2 or more to to1
Enddo
Do While Left(to2.digits,1)=="0"
to2.digits = Substr(to2.digits,2)
lnShift = lnShift + 1 && later add more zeroes to to2 or less to to1
Enddo
Do Case
Case lnShift<0
to1.digits=to1.digits+Replicate("0",-lnShift)
Case lnShift>0
to2.digits=to2.digits+Replicate("0",lnShift)
Endcase
*Assert Len(to1.digits)=Len(to2.digits);
* Message "Divisor and Dividend not aligned correctly"
If to1.digits<to2.digits
* This just makes it easier to divide,
* if divisor is multiplied by 10, result is divided by 10:
lnShift = lnShift - 1
to1.digits = to1.digits+"0"
EndIf
to2.Decimals = lnShift
Endproc
Protected Procedure Normalise(tcSign,tcNum)
If "." $ tcNum
* both leading and trailing zeros are insignificant
tcNum = Rtrim(Alltrim(tcNum,0,"0"),0,".")
Else
* With no decimal point only leading zeros are insignificant,
* trailing zeroes are important (magnitude!)
tcNum = Ltrim(tcNum,0,"0")
Endif
Return tcSign+Evl(tcNum,"0")
Endproc
Enddefine
Please Note: 1 is Bad, 10 is Good :-)
Part and Inventory Search
-
This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.