Huge #'s

[Rook Zimbabwe]

Multiplication is simply addition to the MAX!

[michaeled314]

Oh! That's right! What a @#$%^&!#@ I am sometimes

[Michael Vogel]

Found add but not multiply

Ooops, here we go (once again - even I spent quite a while to create the code - it's definetely not very fast

But for most of the Euler puzzles it was fast enough...

Code: Select all

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

[michaeled314]

Tried mul but it said "Constant not found: MaxPrecision"

[Helle]

Multiply:

Code: Select all

Procedure.s Multi(a.s,b.s)
Protected N.l=100

Protected Dim F1(100)
Protected Dim F2(100)
Protected Dim P(200)
Shared Prod$

For I = 1 To 2*N
    P(I) = 0
Next I

F1$=a.s
F2$=b.s

For I = N - Len(F1$) + 1 To N
   F1(I) = Val(Mid(F1$,I + Len(F1$) - N,1))
Next I

For I = N - Len(F2$) + 1 To N
   F2(I) = Val(Mid(F2$,I + Len(F2$) - N,1))
Next I

For I = N - Len(F2$) + 1 To N
   For K = N To N - Len(f1$) + 1 Step -1
      P(I + K) = P(I + K ) + F1(K) * F2(I)
   Next K
Next I

For I = 2 * N To 1 Step -1
   P(I - 1) = P(I - 1) + Int(P(I) / 10)
   P(I) = P(I) - 10 * Int(P(I) / 10)       
Next I

For I = 1 To 2 * N
   If P(I) = 0 
      S = 1
   EndIf
   
   If P(I) <> 0
      I = 2 * N
   EndIf
Next I

For I = S + 1 To 2 * N
   TestZ$ = Left(Str(P(I)), 1)  
   If TestZ$ <>"0"
      Break
   EndIf
   TestZ$ = ""
Next I

For J = I To 2 * N
    Prod$ = Prod$ + Str(P(J))
Next J

EndProcedure 

Factor1$="123456789098765432198765432123456789"    ;max.100 digits (Dim!)
Factor2$="5555555556666666666777777777777777778765434567654"    ;max 100 digits

Multi(Factor1$, Factor2$)
Debug Prod$

Gruss
Helle

[Demivec]

-Deleted-

[Demivec]

@Helle: I made some modifications to your excellent code sample. Now numbers of any length (# of digits) can be multiplied. It also handles negative numbers as well as positive products.

The negative sign can be place anywhere before the first non-zero digit (i.e. "-563","-000563","0000-563" or "00-00563".

Code: Select all

Procedure.s Multi(F1$,F2$)
  Protected n.l,len_F1.l,len_F2.l
  len_F1=Len(F1$)
  len_F2=Len(F2$)
  If len_F1>len_F2
    n=len_F1
  Else
    n=len_F2
  EndIf
  
  Protected n_2.l=n*2
  Protected Dim F1(n)
  Protected Dim F2(n)
  Protected Dim P(n_2)
  Protected Prod$,I.l,J.l,s.l
  
  For I = n - len_F1 + 1 To n
    F1(I) = Val(Mid(F1$,I + len_F1 - n,1))
  Next I
  
  For I = n - len_F2 + 1 To n
    F2(I) = Val(Mid(F2$,I + len_F2 - n,1))
  Next I 
  
  For I = n - len_F2 + 1 To n
    For J = n To n - len_F1 + 1 Step -1
      P(I + J) = P(I + J ) + F1(J) * F2(I)
    Next J
  Next I
  
  For I = 2 * n To 1 Step -1
    P(I - 1) = P(I - 1) + Int(P(I) / 10)
    P(I) = P(I) - 10 * Int(P(I) / 10)       
  Next I
  
  For I = 1 To n_2
    If P(I) >0
      Break
    EndIf
  Next I
  
  If FindString(F1$,"-",1)
    s=1
  EndIf
  
  If FindString(F2$,"-",1)
    s ! 1
  EndIf
  
  If s=1
    Prod$="-"
  EndIf
  
  For J = I To n_2
    Prod$ + Str(P(J))
  Next J
  
  ProcedureReturn Prod$
EndProcedure

Factor1$="123456789098765432198765432123456789"
Factor2$="5555555556666666666777777777777777778765434567654" 

Prod$=Multi(Factor1$, Factor2$)
Debug Prod$
Factor1$="00012345"
Factor2$="-0009152616"
Prod$=Multi(Factor1$, Factor2$)
Debug Prod$

[Michael Vogel]

Cool :roll:,
around 50% (depending on number length) faster than my procedure and obviously able to handle negative numbers.

My procedure handle also "floating point" numbers, but thats not needed within Project Euler...

I'm quite sure you'll solve some puzzles now

[pdwyer]

What a co-incidence! I was working on this on the weekend for a port of some encryption software to PB.

One thing I found though is that doing math with strings is REALLY slow.

I've been porting it to use BCD ( http://en.wikipedia.org/wiki/Binary-coded_decimal ) since it's just as easy to use as string but all the work happens on numbers so its fast. (one dec per byte though, not per nibble)

I've got (At home so you'll have to wait a few hours) so far:

Add
Subtract
Multiply

I got to divide/mod and took a break which got longer and longer

Still haven't got a plan for floats or negatives yet but I'll have to do something about negatives next.

What needs do you have?

[r_hyde]

pdwyer,
I'm very interested to see some code materialize for BCD div/mod. I've attempted once to wrap my brain around BCD well enough to write these on my own, but frankly that's just not going to happen. I could definitely put it to use, though!

[Michael Vogel]

Hi pdwyer,

interesting thing, I'd like to see the code - maybe some of us can try to add some additional functions (div & mod would be fine, something like integer-squareroot also great)

I'm really interested to see how much faster your routines are :roll:

Michael

[pdwyer]

Hi, Hopefully all the big bugs are out, I've only been on this in spare time over the weekend. (what's with the rolling eyes? I'm in Japan and only got home from work a few hours ago)

I haven't had a chance for speed tests but my guess is that it will be quite a bit better as the string math is gone.

Issues I'm aware of:

1. I haven't added negative number support (I'll add a "sign" element to the Digits structure
2. I need to add some "cleaning" code so that if a number is reused there is no residue in higher decimal values, currently if you assign the number 12345, then later assign 100, there may be times when the "2" 1 digit up gets in the way of the size calc, I just need a quick check of the incomming number size to see if it was bigger and if so, erase the digits to the degree it was bigger by. Get to that later too.

Code: Select all

Structure Digits
    Digit.b[1000]
    InUse.l
EndStructure

Declare ProcMain()
Declare.s OutPut2Str(*Number.Digits)
Declare BigAdd(*Num1.Digits, *Num2.Digits, *Answer.Digits)
Declare BigSubtract(*Num1.Digits, *Num2.Digits, *Answer.Digits) ; Answer = Num1 - Num2
Declare LoadFromText(*Number.Digits, sNumber.s)
Declare LoadFromLong(*Number.Digits, lNumber.l)
Declare BigMultiply(*Num1.Digits, *Num2.Digits, *Answer.Digits)

ProcMain()

;================================================================

Procedure ProcMain()

    Num1.Digits 
    Num2.Digits
    Answer1.Digits
    Answer2.Digits
    Answer3.Digits

    ;Load Numbers
    LoadFromText(@Num1, "43534253452345234532452352352357890808907890")
    LoadFromText(@Num2, "89707890759830658903859036890436905489650")

    ;Add
    BigAdd(@Num1, @Num2, @Answer1)
    Debug OutPut2Str(@Answer1)    
    ;Subtract
    BigSubtract(@Num1, @Num2, @Answer2)
    Debug OutPut2Str(@Answer2)
    
    ;Multiply
    BigMultiply(@Num1, @Num2, @Answer3)
    Debug OutPut2Str(@Answer3)
    
EndProcedure

;================================================================

Procedure LoadFromText(*Number.Digits, sNumber.s)

    StrLen.l = Len(sNumber)
    For i = 0 To StrLen -1 
        *Number\Digit[i] = Val(Mid(sNumber,StrLen - i ,1))
    Next
    *Number\InUse = StrLen

EndProcedure

;================================================================

Procedure LoadFromLong(*Number.Digits, lNumber.l) ;shortcut taken, should be better

    LoadFromText(Number, Str(lNumber))

EndProcedure

;================================================================

Procedure.s OutPut2Str(*Number.Digits)

    sOut.s = ""

    For i = *Number\Inuse - 1  To 0 Step -1
        sOut = sOut + Str(*Number\Digit[i])
    Next
    
    ProcedureReturn sOut

EndProcedure

;================================================================

Procedure BigAdd(*Num1.Digits, *Num2.Digits, *Answer.Digits)

    Carry.b = 0

    ;Calc loop number (needs to find larger number to dim "Answers"
    If *Num1\InUse > *Num2\InUse
        LoopCount = *Num1\InUse 
    Else
        LoopCount = *Num2\InUse 
    EndIf 
    
    ; do add
    For i = 0 To LoopCount - 1 
        *Answer\Digit[i] = *Num1\Digit[i] + *Num2\Digit[i] + Carry
        If *Answer\Digit[i] > 9
            *Answer\Digit[i] - 10
            carry = 1
        Else
            carry = 0
        EndIf
    Next
    
    ; set size
    If *Answer\Digit[LoopCount - 1] = 0
        *Answer\InUse = LoopCount - 1
    Else
        *Answer\InUse = LoopCount
    EndIf
    
EndProcedure

;================================================================

Procedure BigSubtract(*Num1.Digits, *Num2.Digits, *Answer.Digits) ; Answer = Num1 - Num2 (negative output not handled yet)

    Carry.b = 0
    ;Calc loop number (needs to find larger number to dim "Answers"
    If *Num1\InUse > *Num2\InUse
        LoopCount = *Num1\InUse 
    Else
        LoopCount = *Num2\InUse 
    EndIf 
    
    For i = 0 To LoopCount
        *Answer\Digit[i] = *Num1\Digit[i] - *Num2\Digit[i] - Carry
        If *Answer\Digit[i] < 0
            *Answer\Digit[i] + 10
            carry = 1
        Else
            carry = 0
        EndIf
    Next
    
    ; set size
    
    For i = loopCount To 1 Step -1
        If *Answer\Digit[i] <> 0 
            Break
        EndIf
    Next
    
    *Answer\InUse = i + 1
    
EndProcedure

;================================================================

Procedure BigMultiply(*Num1.Digits, *Num2.Digits, *Answer.Digits)

    Dim Temp.Digits(*Num1\InUse - 1)  ;num1 on the bottom row! (outside loop)
    carry.b = 0
    
    ;multiply
    For L1 = 0 To *Num1\InUse -1
        For L2 = 0 To *Num2\InUse
            Temp(L1)\Digit[L2 + L1] = (*Num1\Digit[L1] * *Num2\Digit[L2]) + carry
            carry = Int(Temp(L1)\Digit[L2 + L1] / 10)
            Temp(L1)\Digit[L2 + L1] = Temp(L1)\Digit[L2 + L1] % 10
            Temp(L1)\InUse = L2 + L1
        Next
        carry = 0
    Next
    
    ; and add
    ByteAdds.l = 0  ;temp
     
    For L2 = 0 To *Num1\InUse + *Num2\InUse ;max len of BCD
        ByteAdds = 0
        For L1 = 0 To *Num1\InUse - 1 ;temp array ubound
            ByteAdds = ByteAdds + Temp(L1)\Digit[L2]  ;You want to add down a column 4,0,0 - 0,8,0 - 5,6,6 etc below 
        Next
        
        *Answer\digit[L2] = (ByteAdds + carry )% 10
        carry = Int((ByteAdds + carry)/ 10)
    Next
    
    ; set size
    If *Answer\Digit[*Num1\InUse + *Num2\InUse] = 0
        *Answer\InUse = *Num1\InUse + *Num2\InUse - 1
    Else
        *Answer\InUse = *Num1\InUse + *Num2\InUse
    EndIf

EndProcedure

;================================================================

[pdwyer]

Speed tests...

Mines slower!!

I suppose I'l have to actually read your code now
I was sure the first time I look at this code there were lots of mid() calls etc..

Oh well, can't win em all. I need to finish this anyway, maybe I'll borrow some code afterall

Sorry for sounding like a know-it-all, I should have taken a closer look

[Michael Vogel]

Hi,

I'm also starting in doing BCD, but it's a kind of hybrid now - because I don't know how to be able to keep the number size dynamically without using strings...

So the resulting code is still not fast enough...

Michael

Code: Select all

Structure BCDType
	size.l
	number.s
EndStructure


Procedure StringToBCD(string.s,*BCD.BCDType)
Protected i=Len(string)
*BCD\size=i
*BCD\number=string
While i
i-1
	PokeB(@*BCD\number+i,PeekB(@string+i)-'0')
Wend
EndProcedure
Procedure BCDToString(*BCD.BCDType,*string.s)
Protected i=*BCD\size
*string=*BCD\number
While i
i-1
	PokeB(@*string+i,PeekB(@*BCD\number+i)+'0')
Wend
EndProcedure
Procedure.s BCDtoText(*BCD.BCDType)
Protected i=*BCD\size
Protected string.s=Space(i)
While i
i-1
	PokeB(@string+i,PeekB(@*BCD\number+i)+'0')
Wend
ProcedureReturn string
EndProcedure
Procedure MulBCD(*a.BCDType,*b.BCDType,*mul.BCDType)

		Protected s
		Protected z
		
		Protected la=*a\size
		Protected lb=*b\size

Protected Dim Container(la+lb+1)
		
		If (*a\number=Chr(0)) Or (*b\number=Chr(0))
			*mul\size=1
			*mul\number=Chr(0)
	 Else

		Repeat
			la-1
			lb=*b\size
			z=PeekB(@*a\number+la)
			If z
				Repeat
					lb-1
					s=z*PeekB(@*b\number+lb)+Container(la+lb+1)
					Container(la+lb+1)=s%10
					Container(la+lb)+s/10
				Until lb=0
			EndIf

		Until la=0

If container(0)=0
la=1
EndIf

*mul\size=*a\size+*b\size-la
*mul\number=Space(*mul\size)
lb=0
While la<=*mul\size
PokeB(@*mul\number+lb,Container(la))
la+1
lb+1
Wend
		EndIf

EndProcedure

	
s1.s="11111111111111111111111111111111111111"

b1.BCDType
b2.BCDType
b3.BCDType

StringToBCD(s1,b1)
StringToBCD(s1,b2)

MulBCD(b1,b2,b3)

Debug BCDtoText(b3)

[pdwyer]

Now I read Demivec's code, he's doing BCD already, the code is similar but the array of his must be faster than my structure and the overhead of calcing the size.

Nice. Simple. Effective ( just needs to swap P and J with vars with more meaning)