Squares

General FreeBASIC programming questions.
albert
Posts: 5018
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

@Dodicat

I've been working on the "Squares Over" code to square a number..
I'm trying to get it working , so you can step by 1e9...

Code: Select all

DECLARE FUNCTION multiplier_7(byref num1 as string, byref num2 as string) as string

DECLARE Function minus(NUM1 As String,NUM2 As String) As String
Declare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As String

Declare Function half(fl As String) As String

declare function divide(as string,as string,as integer,as string ="s") as string

Declare function add(n1 as string,n2 as string) as string

screen 19

do

randomize

dim as string num1
for a as longint =  1 to 4 step 1
num1+=str(int(rnd*10))
next
if left(num1,1) = "0" then mid(num1,1,1)=str(int(rnd*9)+1)

dim as double time1
dim as double time2
dim as double time3
dim as double time4

time1 = timer
'===============================================================================
dim as string ans = ""
dim as ubyte val1 = 0
dim as ubyte val2 = 0
dim as ubyte carry = 0
for a as longint = len(num1)-1 to 0 step -1
val1 = ( (num1[a]-48)  ^ 2 ) + carry : carry = 0
val2 = val1 mod 10
carry = val1 \ 10
ans = str(val2) + ans
next
if carry > 0 then ans = str(carry) + ans

dim as string my_answer = ""
for a as longint = len(num1)-1 to 0 step -1
my_answer = plus( my_answer + "0" , ans )
next

dim as string subt = ""
dim as string a1 = ""
dim as longint length =  len(num1)*2
for n1 as longint = 2 to len(num1) step 1
for n as longint = 1 to n1 step 1
a1 = str( abs( (num1[n1-1]-48) - (num1[n-1]-48) )^2 )
a1 = a1 + string( length - n - n1 , "0" )
subt = plus( subt , a1 )
next
next

my_answer = minus( my_answer , subt )

'===============================================================================
time2 = timer

time3 = timer
dim as string answer = multiplier_7( num1 , num1 )
time4 = timer

dim as string difference = minus( answer , my_answer )

print
locate ,1  : print "num1    = " ; num1
'locate ,1  : print "num2    = " ; num2
locate ,1  : print "n1 / n2 = " ; answer
locate ,1  : print "answer  = " ; my_answer

print
locate ,1  : print "difference = " ; difference
print

print
locate ,1  : print "new mul time =  " ; time2-time1
locate ,1  : print "old mul time =  " ; time4-time3

if difference <> "0" then sleep

if inkey = " " then sleep
if inkey = chr(27) then sleep : end

loop until inkey = chr(27)
'===============================================================================
sleep
end
'=================================================
'=================================================
function add(n1 as string,n2 as string) as string
dim as string num1 = n1 ,num2 = n2
dim as ulongint len1,len2
dim as string answer
dim as integer carry
dim as integer val1,val2,tot

dim as string int1,frac1
dim as string int2,frac2
dim as ulongint dec1,dec2

dec1=instr(1,num1,".")
if dec1 >= 1 then
int1=left(num1,dec1-1)
frac1=mid(num1,dec1+1)
else
int1 = num1
frac1=""
end if

dec2=instr(1,num2,".")
if dec2 >= 1 then
int2=left(num2,dec2-1)
frac2=mid(num2,dec2+1)
else
int2 = num2
frac2=""
end if

if len(int1)<len(int2) then int1 = int1 + string(len(int2)-len(int1),"0")
if len(int2)<len(int1) then int2 = int2 + string(len(int1)-len(int2),"0")
if len(frac1)<len(frac2) then frac1 = frac1 + string(len(frac2)-len(frac1),"0")
if len(frac2)<len(frac1) then frac2 = frac2 + string(len(frac1)-len(frac2),"0")

num1=int1+"."+frac1
num2=int2+"."+frac2

len1=len(num1)
len2=len(num2)

carry=0

dim as ulongint l1,l2,la
l1=len(num1)-1
l2=len(num2)-1

dim as ubyte ptr pt1,pt2,pta
pt1 = cptr(ubyte ptr , strptr(num1))+l1
pt2 = cptr(ubyte ptr , strptr(num2))+l2
pta = cptr(ubyte ptr , strptr(answer))+la

for a as integer = len1-1 to 0 step -1
val1=*pt1-48
val2=*pt2-48
if val2>=0 then
tot = (val1)+(val2)+carry+48
carry=0
if tot >=58 then
carry=1
*pta = tot-10
else
*pta = tot
end if
else
*pta=46
end if
pt1-=1
pt2-=1
pta-=1
next

end function
'==================================================
'==================================================
Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As String
Dim As String number=n1,divisor=n2
dpflag=lcase(dpflag)
'For MOD
dim as integer modstop
if dpflag="mod" then
if len(n1)<len(n2) then return n1
if len(n1)=len(n2) then
if n1<n2 then return n1
end if
modstop=len(n1)-len(n2)+1
end if
if dpflag<>"mod" then
If dpflag<>"s"  Then dpflag="raw"
end if
Dim runcount As integer
'_______  LOOK UP TABLES ______________
Dim Qmod(0 To 19) As Ubyte
Dim bool(0 To 19) As Ubyte
For z As Integer=0 To 19
Qmod(z)=(z Mod 10+48)
bool(z)=(-(10>z))
Next z
Dim answer As String   'THE ANSWER STRING

'_______ SET THE DECIMAL WHERE IT SHOULD BE AT _______
Dim As String part1,part2
#macro set(decimal)
#macro insert(s,char,position)
If position > 0 And position <=Len(s) Then
part1=Mid\$(s,1,position-1)
part2=Mid\$(s,position)
s=part1+char+part2
End if
#endmacro
If dpflag="raw" Then
End if
#endmacro
'______________________________________________
'__________ SPLIT A STRING ABOUT A CHARACTRR __________
Dim As String var1,var2
Dim pst As integer
#macro split(stri,char,var1,var2)
pst=Instr(stri,char)
var1="":var2=""
If pst<>0 Then
var1=Rtrim(Mid(stri,1,pst),".")
var2=Ltrim(Mid(stri,pst),".")
Else
var1=stri
End if
#endmacro

#macro Removepoint(s)
split(s,".",var1,var2)
#endmacro
'__________ GET THE SIGN AND CLEAR THE -ve __________________
Dim sign As String
If Left(number,1)="-" Xor Left (divisor,1)="-" Then sign="-"
If Left(number,1)="-" Then  number=Ltrim(number,"-")
If Left (divisor,1)="-" Then divisor=Ltrim(divisor,"-")

'DETERMINE THE DECIMAL POSITION BEFORE THE DIVISION
Dim As integer lennint,lenddec,lend,lenn,difflen
split(number,".",var1,var2)
lennint=Len(var1)
split(divisor,".",var1,var2)
lenddec=Len(var2)

If Instr(number,".") Then
Removepoint(number)
number=var1+var2
End if
If Instr(divisor,".") Then
Removepoint(divisor)
divisor=var1+var2
End if
Dim As integer numzeros
numzeros=Len(number)
number=Ltrim(number,"0"):divisor=Ltrim (divisor,"0")
numzeros=numzeros-Len(number)
lend=Len(divisor):lenn=Len(number)
If lend>lenn Then difflen=lend-lenn
Dim decpos As integer=lenddec+lennint-lend+2-numzeros 'THE POSITION INDICATOR
Dim _sgn As Byte=-Sgn(decpos)
If _sgn=0 Then _sgn=1
Dim As String thepoint=String(_sgn,".") 'DECIMAL AT START (IF)
Dim As String zeros=String(-decpos+1,"0")'ZEROS AT START (IF) e.g. .0009
if dpflag<>"mod" then
If Len(zeros) =0 Then dpflag="s"
end if
Dim As integer runlength
If Len(zeros) Then
runlength=decimal_places
If dpflag="raw" Then
runlength=1
If decimal_places>Len(zeros) Then
runlength=runlength+(decimal_places-Len(zeros))
End If
End If

Else
decimal_places=decimal_places+decpos
runlength=decimal_places
End if
'___________DECIMAL POSITION DETERMINED  _____________

'SET UP THE VARIABLES AND START UP CONDITIONS
number=number+String(difflen+decimal_places,"0")
Dim count As integer
Dim temp As String
Dim copytemp As String
Dim topstring As String
Dim copytopstring As String
Dim As integer lenf,lens
Dim As Ubyte takeaway,subtractcarry
Dim As integer n3,diff
If Ltrim(divisor,"0")="" Then Return "Error :division by zero"
lens=Len(divisor)
topstring=Left(number,lend)
copytopstring=topstring
Do
count=0
Do
count=count+1
copytemp=temp

Do
'___________________ QUICK SUBTRACTION loop _________________

lenf=Len(topstring)
If  lens<lenf=0 Then 'not
If Lens>lenf Then
temp= "done"
Exit Do
End if
If divisor>topstring Then
temp= "done"
Exit Do
End if
End if

diff=lenf-lens
temp=topstring
subtractcarry=0

For n3=lenf-1 To diff Step -1
takeaway= topstring[n3]-divisor[n3-diff]+10-subtractcarry
temp[n3]=Qmod(takeaway)
subtractcarry=bool(takeaway)
Next n3
If subtractcarry=0 Then Exit Do
If n3=-1 Then Exit Do
For n3=n3 To 0 Step -1
takeaway= topstring[n3]-38-subtractcarry
temp[n3]=Qmod(takeaway)
subtractcarry=bool(takeaway)
if subtractcarry=0 then exit do
Next n3
Exit Do

Loop 'single run
temp=Ltrim(temp,"0")
If temp="" Then temp= "0"
topstring=temp
Loop Until temp="done"
' INDIVIDUAL CHARACTERS CARVED OFF ________________
runcount=runcount+1
If count=1 Then
topstring=copytopstring+Mid(number,lend+runcount,1)
Else
topstring=copytemp+Mid(number,lend+runcount,1)
End If
copytopstring=topstring
topstring=Ltrim(topstring,"0")
if dpflag="mod" then
if runcount=modstop then
if topstring="" then return "0"
return mid(topstring,1,len(topstring)-1)
end if
end if
If topstring="" And runcount>Len(n1)+1 Then
Exit Do
End if
Loop Until runcount=runlength+1

' END OF RUN TO REQUIRED DECIMAL PLACES
set(decimal) 'PUT IN THE DECIMAL POINT
'THERE IS ALWAYS A DECIMAL POINT SOMEWHERE IN THE ANSWER
'NOW GET RID OF IT IF IT IS REDUNDANT
If answer="" Then Return "0"
End Function
'===============================================================================
'===============================================================================
Function half(fl As String) As String
Dim As Ubyte main,carry,temp
Dim As String sign   , s
If Instr(fl,".")=0 Then s=fl+".0" Else s=fl+"0"
If Instr(s,"-") Then sign="-":s=Ltrim(s,"-")
Dim As String ans=s
For z As Integer=0 To Len(s)-1
If s[z]<>46 Then
temp=(s[z]-48+carry)
main=temp Shr 1
carry=(temp And 1) Shl 3 +(temp And 1) Shl 1
ans[z]=main+48
End If
Next z
If Instr(ans,".") Then ans=Rtrim(ans,"0")
ans=Rtrim(ans,".")
ans=Ltrim(ans,"0")
Return ans
End Function
'===============================================================================
'===============================================================================
'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
Next z
Var _flag=0,n_=0
#macro finish()
If _flag=1 Then Swap _num2,_num1
#endmacro
If Len(_num2)>Len(_num1) Then
Swap _num2,_num1
_flag=1
End If
Var diff=Len(_num1)-Len(_num2)
For n_=Len(_num1)-1 To diff Step -1
Next n_
finish()
End If
If n_=-1 Then
finish()
Endif
For n_=n_ To 0 Step -1
If addcarry=0 Then Exit For
Next n_
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
'===============================================================================
'===============================================================================
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)
outtext = trim(outtext,"0") 'if multiplying by 1, we have a zero in front.
outtext = outsign + outtext

return outtext

end function
'===============================================================================
'===============================================================================

albert
Posts: 5018
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

@Dodicat

I got it working stepping by 2's , now to make it step by 7's... Then make it use pointers.

Code: Select all

DECLARE FUNCTION multiplier_7(byref num1 as string, byref num2 as string) as string

DECLARE Function minus(NUM1 As String,NUM2 As String) As String
Declare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As String

Declare Function half(fl As String) As String

declare function divide(as string,as string,as integer,as string ="s") as string

Declare function add(n1 as string,n2 as string) as string

screen 19

do

randomize

dim as string num1
for a as longint =  1 to 10 step 1
num1+=str(int(rnd*10))
next
if left(num1,1) = "0" then mid(num1,1,1)=str(int(rnd*9)+1)

dim as double time1
dim as double time2
dim as double time3
dim as double time4

time1 = timer
'===============================================================================
dim as string str1
dim as longint dec1
do
str1 = str( len(num1) / 2 )
dec1 = instr(1,str1,".")
if dec1 <> 0 then num1 = "0" + num1
loop until dec1 = 0

dim as string ans = ""
dim as ulongint val1 = 0
dim as ulongint val2 = 0
dim as ulongint carry = 0
for a as longint = len(num1)-1 to 1 step -2
val1 = ( val(mid(num1,a,2) )  ^ 2 ) + carry : carry = 0
val2 = val1 mod 100
carry = val1 \ 100
ans = right("00" + str(val2) , 2 ) + ans
next
if carry > 0 then ans = str(carry) + ans

dim as string my_answer = ""
for a as longint = len(num1) - 1  to 1 step -2
my_answer = plus( my_answer + "00" , ans )
next

dim as string subt = ""
dim as string a1 = ""
dim as longint length =  len(num1)*2
for n1 as longint = 3 to len(num1)-1  step 2
for n as longint = 1 to n1 step 2
'a1 = str( abs( (num1[n1-1]-48) - (num1[n-1]-48) ) ^ 2 )
a1 = str( abs( val( mid(num1,n1,2) ) -  val( mid(num1,n,2) ) ) ^ 2 )
a1 = a1 + string( len(num1) - n - (n1-2) + abs(len(num1)-4) , "0" )
subt = plus( subt , a1 )
next
next

my_answer = minus( my_answer , subt )

'===============================================================================
time2 = timer

time3 = timer
dim as string answer = multiplier_7( num1 , num1 )
time4 = timer

dim as string difference = minus( answer , my_answer )

print
locate ,1  : print "num1    = " ; num1
'locate ,1  : print "num2    = " ; num2
locate ,1  : print "n1 / n2 = " ; answer
locate ,1  : print "answer  = " ; my_answer

print
locate ,1  : print "difference = " ; difference
print

print
locate ,1  : print "new mul time =  " ; time2-time1
locate ,1  : print "old mul time =  " ; time4-time3

if difference <> "0" then sleep

if inkey = " " then sleep
if inkey = chr(27) then sleep : end

loop until inkey = chr(27)
'===============================================================================
sleep
end
'=================================================
'=================================================
function add(n1 as string,n2 as string) as string
dim as string num1 = n1 ,num2 = n2
dim as ulongint len1,len2
dim as string answer
dim as integer carry
dim as integer val1,val2,tot

dim as string int1,frac1
dim as string int2,frac2
dim as ulongint dec1,dec2

dec1=instr(1,num1,".")
if dec1 >= 1 then
int1=left(num1,dec1-1)
frac1=mid(num1,dec1+1)
else
int1 = num1
frac1=""
end if

dec2=instr(1,num2,".")
if dec2 >= 1 then
int2=left(num2,dec2-1)
frac2=mid(num2,dec2+1)
else
int2 = num2
frac2=""
end if

if len(int1)<len(int2) then int1 = int1 + string(len(int2)-len(int1),"0")
if len(int2)<len(int1) then int2 = int2 + string(len(int1)-len(int2),"0")
if len(frac1)<len(frac2) then frac1 = frac1 + string(len(frac2)-len(frac1),"0")
if len(frac2)<len(frac1) then frac2 = frac2 + string(len(frac1)-len(frac2),"0")

num1=int1+"."+frac1
num2=int2+"."+frac2

len1=len(num1)
len2=len(num2)

carry=0

dim as ulongint l1,l2,la
l1=len(num1)-1
l2=len(num2)-1

dim as ubyte ptr pt1,pt2,pta
pt1 = cptr(ubyte ptr , strptr(num1))+l1
pt2 = cptr(ubyte ptr , strptr(num2))+l2
pta = cptr(ubyte ptr , strptr(answer))+la

for a as integer = len1-1 to 0 step -1
val1=*pt1-48
val2=*pt2-48
if val2>=0 then
tot = (val1)+(val2)+carry+48
carry=0
if tot >=58 then
carry=1
*pta = tot-10
else
*pta = tot
end if
else
*pta=46
end if
pt1-=1
pt2-=1
pta-=1
next

end function
'==================================================
'==================================================
Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As String
Dim As String number=n1,divisor=n2
dpflag=lcase(dpflag)
'For MOD
dim as integer modstop
if dpflag="mod" then
if len(n1)<len(n2) then return n1
if len(n1)=len(n2) then
if n1<n2 then return n1
end if
modstop=len(n1)-len(n2)+1
end if
if dpflag<>"mod" then
If dpflag<>"s"  Then dpflag="raw"
end if
Dim runcount As integer
'_______  LOOK UP TABLES ______________
Dim Qmod(0 To 19) As Ubyte
Dim bool(0 To 19) As Ubyte
For z As Integer=0 To 19
Qmod(z)=(z Mod 10+48)
bool(z)=(-(10>z))
Next z
Dim answer As String   'THE ANSWER STRING

'_______ SET THE DECIMAL WHERE IT SHOULD BE AT _______
Dim As String part1,part2
#macro set(decimal)
#macro insert(s,char,position)
If position > 0 And position <=Len(s) Then
part1=Mid\$(s,1,position-1)
part2=Mid\$(s,position)
s=part1+char+part2
End if
#endmacro
If dpflag="raw" Then
End if
#endmacro
'______________________________________________
'__________ SPLIT A STRING ABOUT A CHARACTRR __________
Dim As String var1,var2
Dim pst As integer
#macro split(stri,char,var1,var2)
pst=Instr(stri,char)
var1="":var2=""
If pst<>0 Then
var1=Rtrim(Mid(stri,1,pst),".")
var2=Ltrim(Mid(stri,pst),".")
Else
var1=stri
End if
#endmacro

#macro Removepoint(s)
split(s,".",var1,var2)
#endmacro
'__________ GET THE SIGN AND CLEAR THE -ve __________________
Dim sign As String
If Left(number,1)="-" Xor Left (divisor,1)="-" Then sign="-"
If Left(number,1)="-" Then  number=Ltrim(number,"-")
If Left (divisor,1)="-" Then divisor=Ltrim(divisor,"-")

'DETERMINE THE DECIMAL POSITION BEFORE THE DIVISION
Dim As integer lennint,lenddec,lend,lenn,difflen
split(number,".",var1,var2)
lennint=Len(var1)
split(divisor,".",var1,var2)
lenddec=Len(var2)

If Instr(number,".") Then
Removepoint(number)
number=var1+var2
End if
If Instr(divisor,".") Then
Removepoint(divisor)
divisor=var1+var2
End if
Dim As integer numzeros
numzeros=Len(number)
number=Ltrim(number,"0"):divisor=Ltrim (divisor,"0")
numzeros=numzeros-Len(number)
lend=Len(divisor):lenn=Len(number)
If lend>lenn Then difflen=lend-lenn
Dim decpos As integer=lenddec+lennint-lend+2-numzeros 'THE POSITION INDICATOR
Dim _sgn As Byte=-Sgn(decpos)
If _sgn=0 Then _sgn=1
Dim As String thepoint=String(_sgn,".") 'DECIMAL AT START (IF)
Dim As String zeros=String(-decpos+1,"0")'ZEROS AT START (IF) e.g. .0009
if dpflag<>"mod" then
If Len(zeros) =0 Then dpflag="s"
end if
Dim As integer runlength
If Len(zeros) Then
runlength=decimal_places
If dpflag="raw" Then
runlength=1
If decimal_places>Len(zeros) Then
runlength=runlength+(decimal_places-Len(zeros))
End If
End If

Else
decimal_places=decimal_places+decpos
runlength=decimal_places
End if
'___________DECIMAL POSITION DETERMINED  _____________

'SET UP THE VARIABLES AND START UP CONDITIONS
number=number+String(difflen+decimal_places,"0")
Dim count As integer
Dim temp As String
Dim copytemp As String
Dim topstring As String
Dim copytopstring As String
Dim As integer lenf,lens
Dim As Ubyte takeaway,subtractcarry
Dim As integer n3,diff
If Ltrim(divisor,"0")="" Then Return "Error :division by zero"
lens=Len(divisor)
topstring=Left(number,lend)
copytopstring=topstring
Do
count=0
Do
count=count+1
copytemp=temp

Do
'___________________ QUICK SUBTRACTION loop _________________

lenf=Len(topstring)
If  lens<lenf=0 Then 'not
If Lens>lenf Then
temp= "done"
Exit Do
End if
If divisor>topstring Then
temp= "done"
Exit Do
End if
End if

diff=lenf-lens
temp=topstring
subtractcarry=0

For n3=lenf-1 To diff Step -1
takeaway= topstring[n3]-divisor[n3-diff]+10-subtractcarry
temp[n3]=Qmod(takeaway)
subtractcarry=bool(takeaway)
Next n3
If subtractcarry=0 Then Exit Do
If n3=-1 Then Exit Do
For n3=n3 To 0 Step -1
takeaway= topstring[n3]-38-subtractcarry
temp[n3]=Qmod(takeaway)
subtractcarry=bool(takeaway)
if subtractcarry=0 then exit do
Next n3
Exit Do

Loop 'single run
temp=Ltrim(temp,"0")
If temp="" Then temp= "0"
topstring=temp
Loop Until temp="done"
' INDIVIDUAL CHARACTERS CARVED OFF ________________
runcount=runcount+1
If count=1 Then
topstring=copytopstring+Mid(number,lend+runcount,1)
Else
topstring=copytemp+Mid(number,lend+runcount,1)
End If
copytopstring=topstring
topstring=Ltrim(topstring,"0")
if dpflag="mod" then
if runcount=modstop then
if topstring="" then return "0"
return mid(topstring,1,len(topstring)-1)
end if
end if
If topstring="" And runcount>Len(n1)+1 Then
Exit Do
End if
Loop Until runcount=runlength+1

' END OF RUN TO REQUIRED DECIMAL PLACES
set(decimal) 'PUT IN THE DECIMAL POINT
'THERE IS ALWAYS A DECIMAL POINT SOMEWHERE IN THE ANSWER
'NOW GET RID OF IT IF IT IS REDUNDANT
If answer="" Then Return "0"
End Function
'===============================================================================
'===============================================================================
Function half(fl As String) As String
Dim As Ubyte main,carry,temp
Dim As String sign   , s
If Instr(fl,".")=0 Then s=fl+".0" Else s=fl+"0"
If Instr(s,"-") Then sign="-":s=Ltrim(s,"-")
Dim As String ans=s
For z As Integer=0 To Len(s)-1
If s[z]<>46 Then
temp=(s[z]-48+carry)
main=temp Shr 1
carry=(temp And 1) Shl 3 +(temp And 1) Shl 1
ans[z]=main+48
End If
Next z
If Instr(ans,".") Then ans=Rtrim(ans,"0")
ans=Rtrim(ans,".")
ans=Ltrim(ans,"0")
Return ans
End Function
'===============================================================================
'===============================================================================
'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
Next z
Var _flag=0,n_=0
#macro finish()
If _flag=1 Then Swap _num2,_num1
#endmacro
If Len(_num2)>Len(_num1) Then
Swap _num2,_num1
_flag=1
End If
Var diff=Len(_num1)-Len(_num2)
For n_=Len(_num1)-1 To diff Step -1
Next n_
finish()
End If
If n_=-1 Then
finish()
Endif
For n_=n_ To 0 Step -1
If addcarry=0 Then Exit For
Next n_
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
'===============================================================================
'===============================================================================
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)
outtext = trim(outtext,"0") 'if multiplying by 1, we have a zero in front.
outtext = outsign + outtext

return outtext

end function
'===============================================================================
'===============================================================================

albert
Posts: 5018
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

@Dodicat

I got it working with stepping by 7's....

Code: Select all

DECLARE FUNCTION multiplier_7(byref num1 as string, byref num2 as string) as string

DECLARE Function minus(NUM1 As String,NUM2 As String) As String
Declare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As String
Declare Function half(fl As String) As String
declare function divide(as string,as string,as integer,as string ="s") as string

Declare function add(n1 as string,n2 as string) as string

screen 19

do

randomize

dim as string num1
for a as longint =  1 to 100 step 1
num1+=str(int(rnd*10))
next
if left(num1,1) = "0" then mid(num1,1,1)=str(int(rnd*9)+1)

dim as double time1
dim as double time2
dim as double time3
dim as double time4

time1 = timer
'===============================================================================
dim as string str1
dim as longint dec1
do
str1 = str( len(num1) / 7 )
dec1 = instr(1,str1,".")
if dec1 <> 0 then num1 = "0" + num1
loop until dec1 = 0

dim as string ans = ""
dim as ulongint val1 = 0
dim as ulongint val2 = 0
dim as ulongint carry = 0
for a as longint = len(num1)-6 to 1 step -7
val1 = ( valulng(mid(num1,a,7) )  ^ 2 ) + carry : carry = 0
val2 = val1 mod 1e7
carry = val1 \ 1e7
ans = right("0000000" + str(val2) , 7 ) + ans
next
if carry > 0 then ans = str(carry) + ans

dim as string my_answer = ""
for a as longint = len(num1) -6  to 1 step -7
my_answer = plus( my_answer + "0000000" , ans )
next

dim as string subt = ""
dim as string a1 = ""
dim as ulongint length = len(num1)
for n1 as longint = 8 to len(num1)-1  step 7
val1 = valulng( mid(num1,n1,7) )
for n as longint = 1 to n1 step 7
val2 = valulng( mid(num1,n,7) )
val2 = abs( val1 - val2 )
a1 = str( val2 * val2 )
a1+= string( length - n - (n1-2) + (length-14) , "0" )
subt = plus( subt , a1 )
next
next

my_answer = minus( my_answer , subt )

'===============================================================================
time2 = timer

time3 = timer
dim as string answer = multiplier_7( num1 , num1 )
time4 = timer

dim as string difference = minus( answer , my_answer )

print
locate ,1  : print "num1    = " ; num1
'locate ,1  : print "num2    = " ; num2
locate ,1  : print "n1 / n2 = " ; answer
locate ,1  : print "answer  = " ; my_answer

print
locate ,1  : print "difference = " ; difference
print

print
locate ,1  : print "new mul time =  " ; time2-time1
locate ,1  : print "old mul time =  " ; time4-time3

if difference <> "0" then sleep

if inkey = " " then sleep
if inkey = chr(27) then sleep : end

loop until inkey = chr(27)
'===============================================================================
sleep
end
'=================================================
'=================================================
function add(n1 as string,n2 as string) as string
dim as string num1 = n1 ,num2 = n2
dim as ulongint len1,len2
dim as string answer
dim as integer carry
dim as integer val1,val2,tot

dim as string int1,frac1
dim as string int2,frac2
dim as ulongint dec1,dec2

dec1=instr(1,num1,".")
if dec1 >= 1 then
int1=left(num1,dec1-1)
frac1=mid(num1,dec1+1)
else
int1 = num1
frac1=""
end if

dec2=instr(1,num2,".")
if dec2 >= 1 then
int2=left(num2,dec2-1)
frac2=mid(num2,dec2+1)
else
int2 = num2
frac2=""
end if

if len(int1)<len(int2) then int1 = int1 + string(len(int2)-len(int1),"0")
if len(int2)<len(int1) then int2 = int2 + string(len(int1)-len(int2),"0")
if len(frac1)<len(frac2) then frac1 = frac1 + string(len(frac2)-len(frac1),"0")
if len(frac2)<len(frac1) then frac2 = frac2 + string(len(frac1)-len(frac2),"0")

num1=int1+"."+frac1
num2=int2+"."+frac2

len1=len(num1)
len2=len(num2)

carry=0

dim as ulongint l1,l2,la
l1=len(num1)-1
l2=len(num2)-1

dim as ubyte ptr pt1,pt2,pta
pt1 = cptr(ubyte ptr , strptr(num1))+l1
pt2 = cptr(ubyte ptr , strptr(num2))+l2
pta = cptr(ubyte ptr , strptr(answer))+la

for a as integer = len1-1 to 0 step -1
val1=*pt1-48
val2=*pt2-48
if val2>=0 then
tot = (val1)+(val2)+carry+48
carry=0
if tot >=58 then
carry=1
*pta = tot-10
else
*pta = tot
end if
else
*pta=46
end if
pt1-=1
pt2-=1
pta-=1
next

end function
'==================================================
'==================================================
Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As String
Dim As String number=n1,divisor=n2
dpflag=lcase(dpflag)
'For MOD
dim as integer modstop
if dpflag="mod" then
if len(n1)<len(n2) then return n1
if len(n1)=len(n2) then
if n1<n2 then return n1
end if
modstop=len(n1)-len(n2)+1
end if
if dpflag<>"mod" then
If dpflag<>"s"  Then dpflag="raw"
end if
Dim runcount As integer
'_______  LOOK UP TABLES ______________
Dim Qmod(0 To 19) As Ubyte
Dim bool(0 To 19) As Ubyte
For z As Integer=0 To 19
Qmod(z)=(z Mod 10+48)
bool(z)=(-(10>z))
Next z
Dim answer As String   'THE ANSWER STRING

'_______ SET THE DECIMAL WHERE IT SHOULD BE AT _______
Dim As String part1,part2
#macro set(decimal)
#macro insert(s,char,position)
If position > 0 And position <=Len(s) Then
part1=Mid\$(s,1,position-1)
part2=Mid\$(s,position)
s=part1+char+part2
End if
#endmacro
If dpflag="raw" Then
End if
#endmacro
'______________________________________________
'__________ SPLIT A STRING ABOUT A CHARACTRR __________
Dim As String var1,var2
Dim pst As integer
#macro split(stri,char,var1,var2)
pst=Instr(stri,char)
var1="":var2=""
If pst<>0 Then
var1=Rtrim(Mid(stri,1,pst),".")
var2=Ltrim(Mid(stri,pst),".")
Else
var1=stri
End if
#endmacro

#macro Removepoint(s)
split(s,".",var1,var2)
#endmacro
'__________ GET THE SIGN AND CLEAR THE -ve __________________
Dim sign As String
If Left(number,1)="-" Xor Left (divisor,1)="-" Then sign="-"
If Left(number,1)="-" Then  number=Ltrim(number,"-")
If Left (divisor,1)="-" Then divisor=Ltrim(divisor,"-")

'DETERMINE THE DECIMAL POSITION BEFORE THE DIVISION
Dim As integer lennint,lenddec,lend,lenn,difflen
split(number,".",var1,var2)
lennint=Len(var1)
split(divisor,".",var1,var2)
lenddec=Len(var2)

If Instr(number,".") Then
Removepoint(number)
number=var1+var2
End if
If Instr(divisor,".") Then
Removepoint(divisor)
divisor=var1+var2
End if
Dim As integer numzeros
numzeros=Len(number)
number=Ltrim(number,"0"):divisor=Ltrim (divisor,"0")
numzeros=numzeros-Len(number)
lend=Len(divisor):lenn=Len(number)
If lend>lenn Then difflen=lend-lenn
Dim decpos As integer=lenddec+lennint-lend+2-numzeros 'THE POSITION INDICATOR
Dim _sgn As Byte=-Sgn(decpos)
If _sgn=0 Then _sgn=1
Dim As String thepoint=String(_sgn,".") 'DECIMAL AT START (IF)
Dim As String zeros=String(-decpos+1,"0")'ZEROS AT START (IF) e.g. .0009
if dpflag<>"mod" then
If Len(zeros) =0 Then dpflag="s"
end if
Dim As integer runlength
If Len(zeros) Then
runlength=decimal_places
If dpflag="raw" Then
runlength=1
If decimal_places>Len(zeros) Then
runlength=runlength+(decimal_places-Len(zeros))
End If
End If

Else
decimal_places=decimal_places+decpos
runlength=decimal_places
End if
'___________DECIMAL POSITION DETERMINED  _____________

'SET UP THE VARIABLES AND START UP CONDITIONS
number=number+String(difflen+decimal_places,"0")
Dim count As integer
Dim temp As String
Dim copytemp As String
Dim topstring As String
Dim copytopstring As String
Dim As integer lenf,lens
Dim As Ubyte takeaway,subtractcarry
Dim As integer n3,diff
If Ltrim(divisor,"0")="" Then Return "Error :division by zero"
lens=Len(divisor)
topstring=Left(number,lend)
copytopstring=topstring
Do
count=0
Do
count=count+1
copytemp=temp

Do
'___________________ QUICK SUBTRACTION loop _________________

lenf=Len(topstring)
If  lens<lenf=0 Then 'not
If Lens>lenf Then
temp= "done"
Exit Do
End if
If divisor>topstring Then
temp= "done"
Exit Do
End if
End if

diff=lenf-lens
temp=topstring
subtractcarry=0

For n3=lenf-1 To diff Step -1
takeaway= topstring[n3]-divisor[n3-diff]+10-subtractcarry
temp[n3]=Qmod(takeaway)
subtractcarry=bool(takeaway)
Next n3
If subtractcarry=0 Then Exit Do
If n3=-1 Then Exit Do
For n3=n3 To 0 Step -1
takeaway= topstring[n3]-38-subtractcarry
temp[n3]=Qmod(takeaway)
subtractcarry=bool(takeaway)
if subtractcarry=0 then exit do
Next n3
Exit Do

Loop 'single run
temp=Ltrim(temp,"0")
If temp="" Then temp= "0"
topstring=temp
Loop Until temp="done"
' INDIVIDUAL CHARACTERS CARVED OFF ________________
runcount=runcount+1
If count=1 Then
topstring=copytopstring+Mid(number,lend+runcount,1)
Else
topstring=copytemp+Mid(number,lend+runcount,1)
End If
copytopstring=topstring
topstring=Ltrim(topstring,"0")
if dpflag="mod" then
if runcount=modstop then
if topstring="" then return "0"
return mid(topstring,1,len(topstring)-1)
end if
end if
If topstring="" And runcount>Len(n1)+1 Then
Exit Do
End if
Loop Until runcount=runlength+1

' END OF RUN TO REQUIRED DECIMAL PLACES
set(decimal) 'PUT IN THE DECIMAL POINT
'THERE IS ALWAYS A DECIMAL POINT SOMEWHERE IN THE ANSWER
'NOW GET RID OF IT IF IT IS REDUNDANT
If answer="" Then Return "0"
End Function
'===============================================================================
'===============================================================================
Function half(fl As String) As String
Dim As Ubyte main,carry,temp
Dim As String sign   , s
If Instr(fl,".")=0 Then s=fl+".0" Else s=fl+"0"
If Instr(s,"-") Then sign="-":s=Ltrim(s,"-")
Dim As String ans=s
For z As Integer=0 To Len(s)-1
If s[z]<>46 Then
temp=(s[z]-48+carry)
main=temp Shr 1
carry=(temp And 1) Shl 3 +(temp And 1) Shl 1
ans[z]=main+48
End If
Next z
If Instr(ans,".") Then ans=Rtrim(ans,"0")
ans=Rtrim(ans,".")
ans=Ltrim(ans,"0")
Return ans
End Function
'===============================================================================
'===============================================================================
'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
Next z
Var _flag=0,n_=0
#macro finish()
If _flag=1 Then Swap _num2,_num1
#endmacro
If Len(_num2)>Len(_num1) Then
Swap _num2,_num1
_flag=1
End If
Var diff=Len(_num1)-Len(_num2)
For n_=Len(_num1)-1 To diff Step -1
Next n_
finish()
End If
If n_=-1 Then
finish()
Endif
For n_=n_ To 0 Step -1
If addcarry=0 Then Exit For
Next n_
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
'===============================================================================
'===============================================================================
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)
outtext = trim(outtext,"0") 'if multiplying by 1, we have a zero in front.
outtext = outsign + outtext

return outtext

end function
'===============================================================================
'===============================================================================

albert
Posts: 5018
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

@Richard

Can you give me the link to your binary converters?

I lost the code somewhere on my computer.. I got too many FB files..Can't remember what i saved them as...

The code that turns a decimal number to binary and back to decimal.
Richard
Posts: 2955
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

No idea of what you remember. Did it handle signs and decimal points, or positive integers only?
Here are simple converters that change between a simple string of ASCII decimal digits, to a minimum length string that contains close-packed binary bits.

Code: Select all

'=======================================================================
' Conversions between ascii numeric strings and packed binary strings
'=======================================================================
' the first location in an ascii number string is the MOST Significant DIGIT
' the first location in a packed binary string is the LEAST significant BYTE
'=======================================================================
' Convert ASCII decimal number to packed binary, Base 10 to Base 256.
'=======================================================================
Function Pax(Byref a As String) As String
Dim As String b = Chr(0)    ' the binary receiver string
Dim As Integer i, j
Dim As Ubyte carry
Dim As Ushort product
For i = 0 To Len(a) - 1     ' most significant decimal digit first
carry = a[i] - Asc("0")     ' prepare to accumulate next digit
For j = 0 To Len(b) - 1     ' acc into LS binary byte first
product = 10 * b[j] + carry
b[j] = Lobyte(product)  ' product Mod 256
carry = Hibyte(product) ' product \ 256
Next j
If carry Then b = b + Chr(carry)  ' extend string only if overflow
Next i
Return b
End Function

'=======================================================================
' Unpack binary number to decimal ASCII, Base256 to Base10
'=======================================================================
Function Unpax(Byref b As String) As String
Dim As String c = Chr(0)    ' an intermediate Base100 receiver string
Dim As Integer i, j, product, carry
For i = Len(b)-1 To 0 Step -1   ' most significant byte first
carry = b[i]
For j = Len(c)-1 To 0 Step -1   ' least significant digit first
product = 256 * c[j] + carry
c[j] = product Mod 100
carry = product \ 100
Next j
Do While carry  ' extend string if overflow remains
c = Chr(carry Mod 100 ) + c
carry = carry  \  100
Loop
Next i
Dim As String d = String( 2*Len(c), 0) ' the decimal receiver string
For i As Integer = 0 To Len(c)-1    ' convert Base100 to ascii string
d[2*i  ] = ( c[i]  \  10 ) + Asc("0")
d[2*i+1] = ( c[i] Mod 10 ) + Asc("0")
Next i
Return Ltrim(d, "0")
End Function

'=======================================================================
' Reverse the order of bytes in a "String" -> "gnirtS"
'=======================================================================
Function gnirts(Byref s As String) As String
Dim As Integer n = Len(s) - 1   ' index 0 to n
Dim As Integer h = n Shr 1      ' midpoint
For i As Integer = 0 To h
Swap s[i], s[n-i]
Next i
Return s
End Function

'=======================================================================
' test the functions
'=======================================================================
Dim As Double start_time, stop_time, pax_time, unpax_time
Dim As Integer n = 250 '10000    ' number of digits in test string
' test the functions
Dim As String a = "" ' "65536" ' "256"
Randomize Timer
For i As Integer = 1 To n
a += Chr( Asc("0")+ Int( Rnd*10 ) )
Next
a = Ltrim(a, "0")
If Len(a) < 1000 Then Print "a= "; a
Print

'-----------------------------------------------------------------------
' pack
Dim As String b
start_time = Timer
b = Pax(a)
stop_time = Timer
pax_time = stop_time - start_time

If Len(a) < 1000 Then
Print "b= Lsb<  ";
For i As Integer = 0 To Len( b ) - 1    ' display the byte values
Print b[i]; " ";
Next i
Print " >Msb"
End If
Print

Print " Number of digits ="; Len(a)
Print
Print Using "   pax time    =######.### msec";   pax_time * 1000

'-----------------------------------------------------------------------
' unpack
Dim As String c
start_time = Timer
c = Unpax(b)
stop_time = Timer
unpax_time = stop_time - start_time
Print Using "  unpax time   =######.### msec"; unpax_time * 1000
If (a <> c) Then
Print " WARNING  Error in conversion. "     ' when a starts with zero
Stop
End If

'-----------------------------------------------------------------------
If Len(c) < 1000 Then Print "c= "; c
If Len(a) < 1000 Then Print "a= "; a

'=======================================================================
Print
Print " Done."
Sleep

'=======================================================================
albert
Posts: 5018
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

@Richard

What i need , is to convert base 10 to base 2 , and base 2 back to base 10...
Richard
Posts: 2955
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

What you actually need is specifications.

I assumed the input was a human readable base ten string, of ASCII digits 0 to 9, without signs or decimal points. But there are just too many possible binary formats available for me to guess at.

I have tried to read your mind, but I am weak and it is too confused for me, so you will have to help by specifying the input and output formats.
albert
Posts: 5018
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

@Richard

I need to convert (base 10) decimal number strings to binary strings (base 2) 5 = "101"
dodicat
Posts: 5938
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Do you mean an extension of bin then val ("&b" + num)?
For only positive integer numbers.
This is probably too slow.
I think I had a faster way, but cannot find it at the moment.

Code: Select all

Function plus(Byval num1 As String,Byval num2 As String) As String
Static As Const Ubyte AddQMod(0 To 19)={48,49,50,51,52,53,54,55,56,57,48,49,50,51,52,53,54,55,56,57}
Static As Const Ubyte AddBool(0 To 19)={0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1}
Var n_=0
#macro finish()
#endmacro
If Len(num2)>Len(num1) Then  Swap num2,num1
Var diff=Len(num1)-Len(num2)
For n_=Len(num1)-1 To diff Step -1
Next n_
finish()
End If
If n_=-1 Then
finish()
End If
For n_=n_ To 0 Step -1
If addcarry=0 Then Exit For
Next n_
finish()
End Function

Function Base10(BinaryNumber As String) As String
Dim As String sum=Left(BinaryNumber,1)
For n As Integer=2 To Len(BinaryNumber)
sum=plus(plus(sum,sum),Chr(BinaryNumber[n-1]))
Next n
Return sum
End Function

Function base2(DecimalNumber As String) As String
Dim As String starter=DecimalNumber,ans,m,b=String(4*Len(DecimalNumber),32)
Dim As Ubyte main,carry,temp
Dim As Long c,lens,idx
Do
c=0
carry=0:ans=starter
For z As Long=0 To Len(starter)-1
temp=(starter[z]-48+carry)
main=temp Shr 1
carry=(temp And 1) Shl 3 +(temp And 1) Shl 1
ans[z]=main+48
Next z
c=carry\10
m=Ltrim(ans,"0")
b[idx]=c+48
starter=m
idx+=1
Loop Until m="1" Orelse m=""
b=Rtrim(b)
lens=Len(b)
For n As Long=0 To Int((lens-1)/2):Swap b[n],b[lens-1-n]:Next'reverse string
b=Str(m)+b
Return b
End Function

Randomize
#define range(f,l) Int(Rnd*((l+1)-(f))+(f))
Dim As String num

Dim As Long size=1000

num=String(size,0)
For n As Long=0 To size-1
If n=0 Then num[n]=range(49,57) Else num[n]=range(48,57)
Next

Print "original"
Print num
Print
Print
Dim As Double t,t2
t=Timer
Var a= base2(num)
t2=Timer
Print "binary"
Print a
Print "time to base two in milliseconds ";(t2-t)*1000
Print
t=Timer
Var b= base10(a)
t2=Timer
Print
Print "back to original"
Print b
Print "time to base 10 in milliseconds ";(t2-t)*1000

Print Iif(b=num,"OK","ERROR")
Sleep

Posts: 1545
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Squares

print bin(val("5")) ?

Edit: too late
albert
Posts: 5018
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

@Dodicat

That's what i needed... dec to bin and bin to dec..

Thank You!!
albert
Posts: 5018
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

@Dodicat

Your right , its too slow..
It takes 2.4 seconds to convert 10,000 digits.

I got to find a faster way...
albert
Posts: 5018
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

@Dodicat

Can you make your base10 - base2 codes so they step by more than 1 digit??

Like 10 decimal digits at a time to base2?
Posts: 1545
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Squares

Like so?

Code: Select all

dim as ulongint x = 9876543210
print x, hex(x, 16)
print x, bin(x, 64)
albert
Posts: 5018
Joined: Sep 28, 2006 2:41
Location: California, USA