Fast Decimal Multiplier

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Fast Decimal Multiplier

Post by albert »

Code: Select all

declare function multiplier(byref num1 as string, byref num2 as string) as string

'test code
dim as double tim1,tim2
dim as string str1,str2,answer
str1 = string(10000,"9") '+ "." + string(10,"9")
str2 = string(10000,"1") '+ "." + string(10,"1")
tim1 = timer
answer = multiplier(str1,str2)
tim2 = timer-tim1

print "length of answer = ";len(answer)-1
print
print answer 
print "length of answer = ";len(answer)-1
print
print "elapsed time in seconds = "; str(tim2)
print "elapsed time in minutes = "; str(tim2/60)

sleep
END

'================================================== 
'================================================== 
'begin functions
'================================================== 
'================================================== 
function multiplier(byref num1 as string, byref num2 as string) as string
    dim as string number1,number2
    dim as string answer,outtext
    dim as string int1,frac1,int2,frac2
    dim as ulongint dec,dec1,len1,len2
    dim as string str1
    dim as string sign1,sign2,outsign
    
    number1 = num1
    number2 = num2
    
    sign1 = left(number1,1)
    if sign1 = "+" or sign1 = "-" then number1 = mid(number1,2) else sign1 = ""
    
    sign2 = left(number2,1)
    if sign2 = "+" or sign2 = "-" then number2 = mid(number2,2) else sign2 = ""
    
    if (sign1 = sign2) then outsign = ""
    if (sign1 <> sign2) then outsign = "-"
    
    dec = instr(1,number1,".")
    if dec > 0 then 
        int1 = left(number1,dec-1)
        frac1 = mid(number1,dec+1)
    else
        int1 = number1
        frac1 = ""
    end if
    
    dec = instr(1,number2,".")
    if dec > 0 then 
        int2 = left(number2,dec-1)
        frac2 = mid(number2,dec+1)
    else
        int2 = number2
        frac2 = ""
    end if

    dec = len(frac1)+len(frac2)
    number1 = int1+frac1
    number2 = int2+frac2

    'swap numbers so that bigger number is number1 and smaller is number2
    if len(number2) > len(number1) then swap number1,number2
    if len(number1) = len(number2) then 
        if val(left(number2,1)) > val(left(number1,1)) then swap number1,number2
    end if

    'make numbers equal multiple of 4 bytes
    do
        str1 = str(len(number1)/4)
        dec1 = instr(1,str1,".")
        if dec1 <> 0 then number1 = "0" + number1
    loop until dec1 = 0
    do
        str1 = str(len(number2)/4)
        dec1 = instr(1,str1,".")
        if dec1 <> 0 then number2 = "0" + number2
    loop until dec1 = 0
    
    'convert the numeric strings to use pointers
    'convert number1
    dim as uinteger ptr uip1 
    uip1 = cptr(uinteger ptr,strptr(number1))
    dim as Uinteger val1
    for a as integer = 0 to len(number1)-1 step 4
        val1 = ((number1[a]-48)*1000) + ((number1[a+1]-48)*100) + ((number1[a+2]-48)*10) + (number1[a+3]-48)
        *uip1 = val1
        uip1+=1
    next
    'convert the numeric strings to use pointers
    'convert number2
    dim as uinteger ptr uip2 
    uip2 = cptr(uinteger ptr,strptr(number2))
    dim as Uinteger val2
    for a as integer = 0 to len(number2)-1 step 4
        val2 = ((number2[a]-48)*1000) + ((number2[a+1]-48)*100) + ((number2[a+2]-48)*10) + (number2[a+3]-48)
        *uip2 = val2
        uip2+=1
    next

    'create accumulator
    answer = "0000" + string(len(number1)+len(number2),"0") 
    'dimension vars for the mul
    dim as integer ptr start1,stop1,start2,stop2 'use longint because the pointers go negative
    dim as uinteger ptr outplace
    dim as ulongint carry
    dim as string result
    dim as integer ptr inc1,inc2
    dim as ulongint total
    dim as ulongint blocknumber1 = len(number1)/4
    dim as ulongint blocknumber2 = len(number2)/4
    dim as ulongint outblocks = len(answer)/4
    
    'set initial accumulator place
    outplace = cptr(uinteger ptr , strptr(answer)) + (outblocks - 1)
    'set initial pointers into number1 
    start1 = cptr(integer ptr , strptr(number1))+(blocknumber1-1)
    stop1 =  cptr(integer ptr , strptr(number1))+(blocknumber1-1)
    'set initial pointers into number2
    start2 = cptr(integer ptr , strptr(number2))+(blocknumber2-1)
    stop2 =  cptr(integer ptr , strptr(number2))+(blocknumber2-1)
    'zero the carry
    carry = 0
    
    'begin looping thru strings multiplying
    do
        'set total to zero
        total = 0
        'we are going to be incrementing thru number2 while decrementing thru number1
        'working in opposite directions from start1 to stop1 and start2 to stop2
        'inc1 works from right to left in the number1 string
        'inc2 works from start2 to stop2 working from left to right, with start2 decrementing each loop.
        inc1 = start1
        inc2 = start2
        do
            'total += ( (number2[inc2]-48) * (number1[inc1]-48) )
            total += *inc2 * *inc1
            inc2 += 1
            inc1 -= 1
        loop until inc2 = stop2+1
        
        total = total + carry
        carry = 0
        
        result = str(total)
        carry = val(left(result,len(result)-4))
        result = right(result,4)
        *outplace = val(result)

        outplace -= 1
        
        'each loop we need to decrement stop1
        'if stop1 goes negative we reset it to zero and decrement stop2
        stop1 -= 1
        if stop1 < cptr(integer ptr,strptr(number1)) then 
            stop1 += 1
            stop2 -=1
            if stop2 < cptr(integer ptr,strptr(number2)) then stop2 += 1
        end if
        'each loop we decrement start2 to the left
        start2 -= 1
        'if start2 goes negative we reset it to zero and decrement start1
        'start1 is the rightmost digit of number1 we need to multiply
        if start2 < cptr(integer ptr,strptr(number2)) then
            start2 += 1
            start1 -= 1
            if start1 < cptr(integer ptr,strptr(number1)) then start1 += 1 
        end if
    
    loop until outplace = cptr(uinteger ptr,strptr(answer))+1
    
    'put in the carry at the end
    if carry > 0  then *outplace = carry else *outplace = 0
    
    'convert answer back to ascii
    for a as ulongint = 1 to outblocks-1 step 1
        val1 = *outplace
        outplace +=1
        outtext = outtext + right("0000" + str(val1),4)
    next    
    
    'put in the decimal point
    outtext = left(outtext,len(outtext)-dec) + "." +  mid(outtext,(len(outtext)-dec)+1)
    'trim leading zeros
    outtext = trim(outtext,"0") 'if multiplying by 1, we have a zero in front.
    outtext = outsign + outtext
return outtext

end function

Post Reply