×
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

Jobs

Microsoft: FoxPro FAQ

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

My Archive

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:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close