String math!

Just starting out? Need help? Post your questions and find answers here.
User avatar
Michael Vogel
Addict
Addict
Posts: 2807
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

String math!

Post by Michael Vogel »

Hi,

since puzzling around wit Project Euler (see also http://www.purebasic.fr/english/viewtopic.php?t=26985) I started programming arithmetic functions for strings...

I think, my implementation of Add(), Sub() and Mul() are not very fast (especially Mul) so maybe someone is able to optimize them! Or, someone is able to add some further functions, like Div(), Sqr() etc.



Code: Select all

#MaxPrecision=1000
Procedure.s Normalize(zahl.s)
	If FindString(zahl,".",1)=0
		zahl+"."
	EndIf
	ProcedureReturn zahl
EndProcedure
Procedure.s AddLeadingZeros(zahl.s,n)
	ProcedureReturn LSet("",n,"0")+zahl
EndProcedure
Procedure.s AddTrailingZeros(zahl.s,n)
	ProcedureReturn zahl+LSet("",n,"0")
EndProcedure
Procedure.s StripZeros(zahl.s)
	Protected i=0
	Protected komma=FindString(zahl,".",1)

	If komma>2
		While (i<komma-2) And (PeekB(@zahl+i)='0')
			i+1
		Wend
		If i>0
			zahl=Mid(zahl,i+1,#MAXSHORT)
			komma-i
		EndIf
	EndIf
	i=Len(zahl)-1
	While (i>komma) And (PeekB(@zahl+i)='0')
		i-1
	Wend
	zahl=Left(zahl,i+1)
	ProcedureReturn zahl
EndProcedure
Procedure.s Add(a.s,b.s)

	Protected i
	Protected k
	Protected s
	Protected sum.s

	a=Normalize(a)
	b=Normalize(b)
	Protected komm_a=FindString(a,".",1)
	Protected komm_b=FindString(b,".",1)

	If komm_a>komm_b : Swap a,b : Swap komm_a,komm_b :EndIf

	a=AddLeadingZeros(a,komm_b-komm_a+1)
	b=AddLeadingZeros(b,1)

	Protected len_a=Len(a)
	Protected len_b=Len(b)

	If len_a<len_b
		a=AddTrailingZeros(a,len_b-len_a)
	Else
		b=AddTrailingZeros(b,len_a-len_b)
	EndIf

	i=Len(a)
	k=FindString(a,".",1)-1
	s=0
	sum=Space(i)

	While i
		i-1
		If i=k
			PokeB(@sum+i,'.')
		Else
			s+PeekB(@a+i)+PeekB(@b+i)-96
			PokeB(@sum+i,s%10+48)
			s=s/10
		EndIf
	Wend

	ProcedureReturn StripZeros(sum)
EndProcedure
Procedure.s Mul(a.s,b.s)

	Protected lena,lenb
	Protected summe=0
	Protected mul.s
	Protected ziffer

	a=Normalize(a)
	b=Normalize(b)
	Protected komm_a=FindString(a,".",1)
	Protected komm_b=FindString(b,".",1)

	a=Left(a,komm_a-1)+Mid(a,komm_a+1,#MAXSHORT)
	b=Left(b,komm_b-1)+Mid(b,komm_b+1,#MAXSHORT)

	lena=Len(a)
	lenb=Len(b)

	mul=LSet("0",lena+lenb,"0")

	Repeat
		lena-1
		lenb=Len(b)
		ziffer=(PeekB(@a+lena)-48)
		If ziffer
			Repeat
				lenb-1
				If lena+lenb<#MaxPrecision

					summe=(PeekB(@a+lena)-48)*(PeekB(@b+lenb)-48)+(PeekB(@mul+lena+lenb+1)-48);Puffer(lena+lenb+1)
					;Puffer(lena+lenb+1)=summe%10
					;Puffer(lena+lenb)+summe/10
					PokeB(@mul+lena+lenb+1,summe%10+48)
					PokeB(@mul+lena+lenb,PeekB(@mul+lena+lenb)+summe/10)
				EndIf
			Until lenb=0
		EndIf
	Until lena = 0

	ProcedureReturn StripZeros(Left(mul,komm_a+komm_b-2)+"."+Mid(mul,komm_a+komm_b-1,#MAXSHORT))
EndProcedure
Example:

Debug Mul("12345.6789","987654321.123456789")
Derek
Addict
Addict
Posts: 2354
Joined: Wed Apr 07, 2004 12:51 am
Location: England

Post by Derek »

Seems to crash the compiler the first time it is run and then will only run using the external debugger, then it crashes every other time or so. Very strange.
User avatar
Michael Vogel
Addict
Addict
Posts: 2807
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Post by Michael Vogel »

Derek wrote:Seems to crash the compiler the first time it is run and then will only run using the external debugger, then it crashes every other time or so. Very strange.
Absolute strange, just did a copied and pasted the code into PB4.02 and checked it - no error here...
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Post by rsts »

Runs fine here - 4.02 on winxp.

Very nice functionality. Thanks for sharing with us.

cheers
User avatar
Michael Vogel
Addict
Addict
Posts: 2807
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Post by Michael Vogel »

rsts wrote:Runs fine here - 4.02 on winxp.
Very nice functionality. Thanks for sharing with us.
cheers
rsts, you're welcome ! :)

But even it took me a while to write these functions, they are not perfect - you can easily check this...

Set the maximum string length to a high value (e.g. #MaxPrecision=1000) and do something like this:

Code: Select all

a$="1.0000001"
For i=1 To 26
	a$=(Mul(a$,a$))
Next i
Debug a$
This will already take some seconds - so how to do that faster?
And what's about Sub(), Div(), Sqr()? Who is a freak in assembler? Or just in math :wink:
Derek
Addict
Addict
Posts: 2354
Joined: Wed Apr 07, 2004 12:51 am
Location: England

Post by Derek »

Just copied onto the laptop and it is absolutely fine, as I thought it might be.

Just another problem with my computer which I will never be able to track down, unless it has anything to do with dual core, my laptop isn't dc whereas my other computer is.

Now I know it works on my laptop I will see if I can get round to writing a faster routine, don't hold your breath though as your routine looks good to me.
Trond
Always Here
Always Here
Posts: 7446
Joined: Mon Sep 22, 2003 6:45 pm
Location: Norway

Post by Trond »

Faster Add:

Code: Select all

Structure MemoryArray
  C.c[0]
EndStructure

Procedure.s Add2(*A.MemoryArray, *B.MemoryArray)
  Protected Sum.l
  Protected Carry.l
  Protected LenA = MemoryStringLength(*A)
  Protected LenB = MemoryStringLength(*B)
  Protected Nd.l = LenA + LenB
  Protected *C.MemoryArray = AllocateMemory(Nd+2)
  Protected Result.s
  
  ; Both common length
  Repeat
    LenA - 1
    LenB - 1
    Nd - 1
    Sum = (*A\c[LenA]-'0') + *B\c[LenB] + Carry; -'0'+'0'
    If Sum > '9'
      *C\c[Nd] = Sum - 10
      Carry = 1
    Else
      *C\c[Nd] = Sum
      Carry = 0
    EndIf
  Until LenA = 0 Or LenB = 0
  
  ; A is longer, B is leading 0
  While LenA
    LenA - 1
    Nd - 1
    Sum = *A\c[LenA] + Carry
    If Sum > '9'
      *C\c[Nd] = Sum - 10
      Carry = 1
    Else
      *C\c[Nd] = Sum
      Carry = 0
    EndIf
  Wend
  
  ; B is longer, A is leading 0
  While LenB
    LenB - 1
    Nd - 1
    Sum = *B\c[LenB] + Carry
    If Sum > '9'
      *C\c[Nd] = Sum - 10
      Carry = 1
    Else
      *C\c[Nd] = Sum
      Carry = 0
    EndIf
  Wend
  
  ; Carry
  If Carry
    Nd - 1
    *C\c[Nd] = '1'
  EndIf
  
  Result = PeekS(*C+Nd)
  FreeMemory(*C)
  ProcedureReturn Result
EndProcedure
It should be about 5 times faster for doing this:
add2(@"123", @"1234435676789")
add2(@"9234435676789", @"9234435676789")
add2(@"70386486105843025439939619828917593665686757934951", @"9234435676789")
Mistrel
Addict
Addict
Posts: 3415
Joined: Sat Jun 30, 2007 8:04 pm

Post by Mistrel »

This is pretty cool. I can imagine some real use for this if it could handle floating point numbers.
User avatar
Michael Vogel
Addict
Addict
Posts: 2807
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Post by Michael Vogel »

Mistrel wrote:This is pretty cool. I can imagine some real use for this if it could handle floating point numbers.
Hi, maybe you will have also a look into the thread http://www.purebasic.fr/english/viewtop ... highlight=, here is a much faster version (VNF) which already supports positive and negative integers for Add, Sub, Mul and (partially) Div!

Floating point is not supported, but for small projects you could just "remember" the position of the floating point and make your own output routine which inserts the point at the right position...

Michael
Post Reply