×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

#### Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
• Talk With Other Members
• Be Notified Of Responses
To Your Posts
• Keyword Search
• One-Click Access To Your
Favorite Forums
• Automated Signatures
On Your Posts
• Best Of All, It's Free!
• Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

#### Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

# Microsoft: FoxPro FAQ

 Forum Search FAQs Links MVPs

## String Commands

How to calculate with more precision by Olaf Doschke
Posted: 25 Jan 16

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.

#### 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 

Back to Microsoft: FoxPro FAQ Index
Back to Microsoft: FoxPro Forum

Close Box

# Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

• Talk To Other Members
• Notification Of Responses To Questions
• Favorite Forums One Click Access
• Keyword Search Of All Posts, And More...

Register now while it's still free!

Already a member? Close this window and log in.