Your to_bin() code is erroring... try setting size to different longer values , above size = 14 , it errors when an added bin place goes higher than 9..
Code: Select all
Declare Function mul_ascii( byref num1 as string, byref num2 as string) as string
Declare Function mul_var_bin( num1 as string , num2 as string , bits as longint ) as string
Declare Function multiplier_7( num1 as string, num2 as string) as string
Declare Function base_2_to_10( Byref b As String ) As String ' b may be lengthened
Declare Function base_10_to_2( Byref d As String ) As String ' d may be lengthened
Declare Function minus(NUM1 As String,NUM2 As String) As String
Declare Function plus( NUMber1 As String , NUMber2 As String ) As String
screen 19
dim as double time1 , time2 , time3 , time4
do
dim as longint size = 21
dim as string n1 = ""
do
n1=""
for x as longint = 1 to size
n1+= str( int( rnd*2 ) )
next
n1 = ltrim(n1,"0")
loop until n1 > "0"
dim as string n2 = ""
do
n2 = ""
for x as longint = 1 to size
n2+= str( int( rnd*2 ) )
next
n2 = ltrim(n2,"0")
loop until n2 > "0"
time1=timer
dim as string v1 = n1
dim as string v2 = n2
dim as string mul1 = base_2_to_10( v1 )
dim as string mul2 = base_2_to_10( v2 )
dim as string mul_bin = multiplier_7( mul1 , mul2 )
mul_bin = left( mul_bin , len( mul_bin ) - 1 )
mul_bin = base_10_to_2(mul_bin)
time2 = timer
time3=timer
dim as string mul_albert = mul_ascii( n1 , n2 )
dim as string s = mul_albert
Dim As Integer c = 0, i = Len( s )
'Richards to_bin()
Do While i ' sweep carry along the string
i -= 1
c += s[ i ] - Asc("0")
s[ i ] = Iif( c And 1, Asc("1"), Asc("0") )
c Shr= 1
Loop
Do While c ' extend string if carry overflows
s = Iif( c And 1, "1", "0" ) + s
c Shr= 1
Loop
mul_albert = s
time4=timer
dim as string diff = minus( mul_bin , mul_albert)
if inkey = chr(27) then end
print
print "n1 = " ; n1
print "n2 = " ; n2
print "ans = " ; mul_bin
print "me = " ; mul_albert
print
print "diff = " ; diff
print
print "time mul = " ; time2-time1
print "time albert = "; time4-time3
if diff <> "0" then print "ERROR" : sleep
if inkey = " " then sleep
if inkey = chr(27) then end
loop
END
'==================================================
'==================================================
'begin functions
'==================================================
'==================================================
'===============================================================================
'===============================================================================
'Dodicats plus & Minus functions
'===============================================================================
'===============================================================================
Function plus(_num1 As String,_num2 As String) As String
Dim ADDQmod(0 To 19) As Ubyte
Dim ADDbool(0 To 19) As Ubyte
For z As Integer=0 To 19
ADDQmod(z)=(z Mod 10+48)
ADDbool(z)=(-(10<=z))
Next z
Var _flag=0,n_=0
Dim As Ubyte addup=Any,addcarry=Any
#macro finish()
answer=Ltrim(answer,"0")
If _flag=1 Then Swap _num2,_num1
Return answer
#endmacro
If Len(_num2)>Len(_num1) Then
Swap _num2,_num1
_flag=1
End If
Var diff=Len(_num1)-Len(_num2)
Var answer="0"+_num1
addcarry=0
For n_=Len(_num1)-1 To diff Step -1
addup=_num2[n_-diff]+_num1[n_]-96
answer[n_+1]=ADDQmod(addup+addcarry)
addcarry=ADDbool(addup+addcarry)
Next n_
If addcarry=0 Then
finish()
End If
If n_=-1 Then
answer[0]=addcarry+48
finish()
Endif
For n_=n_ To 0 Step -1
addup=_num1[n_]-48
answer[n_+1]=ADDQmod(addup+addcarry)
addcarry=ADDbool(addup+addcarry)
If addcarry=0 Then Exit For
Next n_
answer[0]=addcarry+48
finish()
End Function
'===============================================================================
'===============================================================================
Function minus(NUM1 As String,NUM2 As String) As String
'Dim As String copyfirstnum=mul_num_1,copysecondnum=mul_num_2
Dim As Byte swapflag
Dim As Long lenf,lens
Dim sign As String * 1
'Dim As String part1,part2
Dim bigger As Byte
'set up tables
Dim As Ubyte Qmod(0 To 19)
Dim bool(0 To 19) As Ubyte
For z As Integer=0 To 19
Qmod(z)=cubyte(z Mod 10+48)
bool(z)=cubyte(-(10>z))
Next z
lenf=Len(NUM1)
lens=Len(NUM2)
#macro compare(numbers)
If Lens>lenf Then bigger= -1:Goto fin
If Lens<lenf Then bigger =0:Goto fin
If NUM2>NUM1 Then
bigger=-1
Else
bigger= 0
End If
fin:
#endmacro
compare(numbers)
If bigger Then
sign="-"
Swap NUM2,NUM1
Swap lens,lenf
swapflag=1
Endif
'lenf=Len(NUM1)
'lens=Len(NUM2)
Dim diff As Long=lenf-lens-Sgn(lenf-lens)
Dim As String one,two,three
three=NUM1
two=String(lenf-lens,"0")+NUM2
one=NUM1
Dim As Long n2
Dim As Ubyte takeaway,subtractcarry
Dim As Ubyte ten=10
'Dim z As Long
subtractcarry=0
Do
For n2=lenf-1 To diff Step -1
takeaway= one[n2]-two[n2]+ten-subtractcarry
three[n2]=Qmod(takeaway)
subtractcarry=bool(takeaway)
Next n2
If subtractcarry=0 Then Exit Do
If n2=-1 Then Exit Do
For n2=n2 To 0 Step -1
takeaway= one[n2]-two[n2]+ten-subtractcarry
three[n2]=Qmod(takeaway)
subtractcarry=bool(takeaway)
Next n2
Exit Do
Loop
three=Ltrim(three,"0")
If three="" Then Return "0"
If swapflag=1 Then Swap NUM1,NUM2
Return sign+three
End Function
'=======================================================================
' Convert base two ASCII binary string to base ten ASCII decimal string
'=======================================================================
Function base_2_to_10( Byref b As String ) As String ' b may be lengthened
' lengthen input string by up to 28 zero bits to make 29 bit blocks
Dim As Integer n = Len( b ) Mod 29
If n Then b = String( 29 - n, "0" ) + b
n = Len( b ) \ 29 ' number of input blocks
Dim As Ulong acc( 0 To n ) ' accumulator array
' convert blocks of 9 digits to binary in 32 bit Ulong
Dim As Ulongint product, carry ' 64 bit Unsigned Integer
Dim As Integer i, j, k = 1 ' loop counters
For j = 1 To Len( b ) Step 29 ' the blocks to convert
carry = Valulng( "&b" + Mid( b, j, 29 ) ) ' value of 29 bit block
For i = 0 To k ' Multiply Accumulate, 2^29 = 536870912
product = ( Culngint( acc( i ) ) * 536870912ull ) + carry
acc( i ) = product Mod 1000000000ull ' sum is low part
carry = product \ 1000000000ull ' carry is the high part
Next i
If carry Then ' extend accumulator by one element when needed
k += 1
acc( k ) = carry
End If
Next j ' accumulator now contains result blocks of base 1 billion
' unpack and return acc as decimal ASCII string
Dim As String txt
For i = n To 0 Step -1
txt += Right( "000000000" + Str( acc( i ) ), 9 )
Next i
Return Ltrim( txt, "0" )
End Function
'=======================================================================
' Convert base ten ASCII decimal string to base two ASCII binary string
'=======================================================================
Function base_10_to_2( Byref d As String ) As String ' d may be lengthened
'================================================
'begin alberts additons
'================================================
dim as string number = d
dim as string str1
dim as longint dec1
do
str1 = str( len(number) / 9 )
dec1 = instr(1,str1,".")
if dec1 <> 0 then number = "0" + number
loop until dec1 = 0
'convert the numeric strings to use pointers
'convert number1
dim as string n1 = string(len(number)*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(number)-1 step 9
val1 = (number[a+0]-48)*100000000ull
val1+= (number[a+1]-48)*10000000ull
val1+= (number[a+2]-48)*1000000ull
val1+= (number[a+3]-48)*100000ull
val1+= (number[a+4]-48)*10000ull
val1+= (number[a+5]-48)*1000ull
val1+= (number[a+6]-48)*100ull
val1+= (number[a+7]-48)*10ull
val1+= (number[a+8]-48)*1
*ulp1 = val1
ulp1+=1
len_1+=8
next
number = left(n1,len_1)
n1=""
'================================================
'end alberts additons
'================================================
Dim As ulongint acc( 0 To len(number) \ 8 ) ' the accumulator array
Dim As Ulongint product, carry ' 64 bit Unsigned Integer
Dim As Integer k = 1 ' loop counters
dim as ulongint ptr ulp2
ulp1 = cptr(ulongint ptr,strptr(number))
For j as longint = 1 To Len(number) Step 8 ' the blocks to convert
'carry = Valulng( Mid( d, j, 9 ) ) ' get value of 9 digit block
carry = *ulp1
ulp1+=1
ulp2 = cptr( ulongint ptr , varptr( acc(0) ) )
For i as longint = 0 To k ' Multiply Accumulate
product = culngint( *ulp2 * 1000000000ull ) + carry
*ulp2 = product and 4294967295 ' sum is low order 32 bits
carry = product shr 32 ' carry is the high order 32 bits
ulp2+=1
Next i
If carry Then ' extend accumulator by one element when needed
k+=1
*ulp2 = carry
End If
Next j ' accumulator now contains result in packed binary
' unpack and return it as binary ASCII string
Dim As String txt
For i as longint = k to lbound(acc) Step -1
txt+= Bin( acc(i) ,32 )
Next i
Return ltrim( txt , "0")
End Function
'===============================================================================
'===============================================================================
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
'=======================================================================
'=======================================================================
function mul_var_bin( num1 as string , num2 as string , bits as longint ) as string
dim as string number1 = num1
dim as string number2 = num2
dim as longint size = bits
'make numbers equal multiple of 7 bytes
dim as string str1
dim as longint dec1
do
str1 = str(len(number1)/size)
dec1 = instr(1,str1,".")
if dec1 <> 0 then number1 = "0" + number1
loop until dec1 = 0
do
str1 = str(len(number2)/size)
dec1 = instr(1,str1,".")
if dec1 <> 0 then number2 = "0" + number2
loop until dec1 = 0
dim as string answer = ""
dim as longint start1 = len(number1)-size+1
dim as longint stop1 = len(number1)-size+1
dim as longint start2 = len(number2)-size+1
dim as longint stop2 = len(number2)-size+1
dim as longint inc1 , inc2
dim as ulongint total
dim as string result = ""
dim as longint place = len(number1) + len(number2)
do
total = 0
inc1 = start1
inc2 = start2
do
total += val( "&B" + mid(number1,inc1,size) ) * val( "&B" + mid(number2,inc2,size) )
inc2 += size
inc1 -= size
loop until inc1 < size
total = val("&B"+bin(total)) + val("&B"+result)
result = bin(total)
answer = right(string(size,"0")+ result,size) + answer
result = left(result,len(result)-size)
stop1 -= size
if stop1 = 0 then
stop1+= 1
stop2-= size
if stop2 = 0 then stop2 += 1
end if
start2 -= size
if start2 = 0 then
start2 += 1
start1 -= size
if start1 = 0 then start1 +=1
end if
place-=size
loop until place < 1
answer = result + answer
answer = ltrim(answer,"0")
return answer
end function
'===============================================================================
'===============================================================================
function mul_ascii( byref num1 as string, byref num2 as string) as string
dim as string number1,number2
dim as string answer,outtext
dim as ulongint dec1
dim as string str1
number1 = num1
number2 = num2
'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 mod 1e7
'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
outtext = ltrim(outtext,"0") 'if multiplying by 1, we have a zero in front.
return outtext
end function