Nice Albert.
Here is an adaptation of dafhi's function.
Code: Select all
DECLARE FUNCTION multiplier_7(byref num1 as string, byref num2 as string) as string
'From Dafhi's idea
function ValMid(byref st as string, s as long, e as long ) as ulongint
's=iif(s<=0,1,s)
if s<=0 then return 0
var L=*Cast(integer Ptr,Cast(integer,@st)+sizeof(integer))' same as len(st)
if e > L then e = L-1
dim as longint decim = 1, ans
for i as long = e-1 + s-1 to s-1 step -1
ans += (st[i]-48)*decim
decim = (decim ) Shl 3 +(decim ) Shl 1 ' same as decim*=10
next
return (ans)
end function
'screen 19
do
dim as string num1
dim as string num2
for a as longint = 1 to 1000 step 1
num1+=str(int(rnd*10))
next
for a as longint = 1 to 1000 step 1
num2+=str(int(rnd*10))
next
if len(num2) < len(num1) then swap num1 , num2
print
print num1
print num2
print
dim as double t1 , t2
t1 = timer
dim as string short_mul( 0 to 9 )
for a as ubyte = 0 to 9 step 1
dim as string value=""
dim as ubyte mul
dim as ubyte carry
dim as string check=""
for b as longint = len(num1)-1 to 0 step -1
mul = ( ( num1[ b ] -48 ) * a ) + carry
carry = 0
check = right("00" + str(mul) , 2)
carry = val(left(check,1))
check = right(check,1)
value = str(check) + value
next
if carry <> 0 then value = str(carry) + value
short_mul(a) = value
next
dim as longint max = len(short_mul(9))
for a as ubyte = 0 to 9 step 1
if len(short_mul(a)) < max then short_mul(a) = "0" + short_mul(a)
next
dim as string answer = ""
dim as longint value = 0
dim as ubyte vals = 0
dim as longint place = 0
dim as longint hold = 0
dim as longint locat = 0
dim as string carry = ""
dim as longint start = 0
dim as longint ends = 0
dim as longint steps = -1
dim as byte toggle = 0
do
carry=""
for a as longint = hold to 0 step -1
vals = valmid( num2 , len(num2) - locat , 1 ) '**************
value+= valmid( short_mul( vals ) , len( short_mul(0) ) - a , 1 ) '*************
locat+= 1
' print value , locat , a
next
locat=0
hold+= 1
dim as string check = right( string( 16,"0") + str(value) , 16 )
dim as string rght = right( check , 1 )
carry = left( check , 15 )
value = valulng(carry)
answer= rght + answer
loop until hold = len(num2)+len(num1)
answer = ltrim(answer,"0")
t2 = timer
print answer
print
dim as string real_answer = multiplier_7( num1 , num2 )
real_answer = rtrim( real_answer,".")
print real_answer
print
print "Time = " ; t2 - t1
sleep
loop until inkey=chr(27)
sleep
end
'===============================================================================
'===============================================================================
function multiplier_7(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 7 bytes
do
str1 = str(len(number1)/7)
dec1 = instr(1,str1,".")
if dec1 <> 0 then number1 = "0" + number1
loop until dec1 = 0
do
str1 = str(len(number2)/7)
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 string n1 = string(len(number1)*8,chr(0))
dim as ulongint ptr ulp1
ulp1 = cptr(ulongint ptr,strptr(n1))
dim as longint val1
dim as longint len_1 = 0
dim as uinteger a
for a = 0 to len(number1)-1 step 7
val1 = (number1[a+0]-48)*1000000ull
val1+= (number1[a+1]-48)*100000ull
val1+= (number1[a+2]-48)*10000ull
val1+= (number1[a+3]-48)*1000ull
val1+= (number1[a+4]-48)*100ull
val1+= (number1[a+5]-48)*10ull
val1+= (number1[a+6]-48)*1ull
*ulp1 = val1
ulp1+=1
len_1+=8
next
number1 = left(n1,len_1)
n1=""
'convert the numeric strings to use pointers
'convert number2
dim as string n2 = string(len(number2)*8,chr(0))
dim as ulongint ptr ulp2
ulp2 = cptr(ulongint ptr,strptr(n2))
dim as longint val2
dim as longint len_2 = 0
for a = 0 to len(number2)-1 step 7
val2 = (number2[a+0]-48)*1000000ull
val2+= (number2[a+1]-48)*100000ull
val2+= (number2[a+2]-48)*10000ull
val2+= (number2[a+3]-48)*1000ull
val2+= (number2[a+4]-48)*100ull
val2+= (number2[a+5]-48)*10ull
val2+= (number2[a+6]-48)*1ull
*ulp2 = val2
ulp2+=1
len_2+=8
next
number2 = left(n2,len_2)
n2=""
'create accumulator
answer = string( len(number1) + len(number2) + 8 , chr(0) )
'dimension vars for the mul
dim as longint ptr start1,stop1,start2,stop2 'use longint because the pointers go negative
dim as longint ptr chk_1 , chk_2
dim as longint ptr inc1,inc2
dim as longint ptr outplace
dim as ulongint carry
dim as ulongint total
dim as ulongint blocknumber1 = len(number1)/8
dim as ulongint blocknumber2 = len(number2)/8
dim as ulongint outblocks = len(answer)/8
'set initial accumulator place
outplace = cptr(longint ptr , strptr(answer)) + (outblocks - 1)
'set initial pointers into number1
start1 = cptr(longint ptr , strptr(number1))+(blocknumber1-1)
stop1 = cptr(longint ptr , strptr(number1))+(blocknumber1-1)
'set initial pointers into number2
start2 = cptr(longint ptr , strptr(number2))+(blocknumber2-1)
stop2 = cptr(longint ptr , strptr(number2))+(blocknumber2-1)
'set comparison to beg of numbers
chk_1 = cptr( longint ptr , strptr(number1))
chk_2 = cptr( longint ptr , strptr(number2))
'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 top number1 string
'inc2 works from start2 to stop 2, in the bottom number2 string, decrementing each loop.
inc1 = start1
inc2 = start2
do
total += *inc1 * *inc2
inc1-= 1
inc2+= 1
loop until inc2 = stop2+1
total = total + carry
carry = total \ 1e7
*outplace = total mod 1e7
'*outplace = imod(total , 1e7)
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 < chk_1 then
stop1 += 1
stop2 -=1
if stop2 < chk_2 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 < chk_2 then
start2 += 1
start1 -= 1
if start1 < chk_1 then start1+=1
end if
loop until outplace = cptr(ulongint 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("0000000" + str(val1),7)
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
'===============================================================================
'===============================================================================
