Squares

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

Re: Squares

Post by albert »

@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 )
        answer = left(answer,len(answer)-1)
    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
'=================================================
'alberts addition function
'=================================================
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)
    
    answer = string(len1,"0")
    carry=0
    
    dim as ulongint l1,l2,la
    l1=len(num1)-1
    l2=len(num2)-1
    la=len(answer)-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
    
    if carry>0 then answer=str(carry)+answer
    
    return answer
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
insert(answer,".",decpos)
  answer=thepoint+zeros+answer
If dpflag="raw" Then
    answer=Mid(answer,1,decimal_places)
    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
     answer=String(Len(zeros)+runlength+10,"0")
    If dpflag="raw" Then 
        runlength=1
        answer=String(Len(zeros)+runlength+10,"0")
        If decimal_places>Len(zeros) Then
            runlength=runlength+(decimal_places-Len(zeros))
            answer=String(Len(zeros)+runlength+10,"0")
            End If
            End If

Else
decimal_places=decimal_places+decpos
runlength=decimal_places
answer=String(Len(zeros)+runlength+10,"0")
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
       answer[runcount-1]=count+47
       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
       answer=Rtrim(answer,"0")
       answer=Rtrim(answer,".")
       answer=Ltrim(answer,"0")
       If answer="" Then Return "0"
   Return sign+answer
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
            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
'===============================================================================
'===============================================================================
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
'===============================================================================
'===============================================================================

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

Re: Squares

Post by albert »

@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 )
        answer = left(answer,len(answer)-1)
    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
'=================================================
'alberts addition function
'=================================================
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)
    
    answer = string(len1,"0")
    carry=0
    
    dim as ulongint l1,l2,la
    l1=len(num1)-1
    l2=len(num2)-1
    la=len(answer)-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
    
    if carry>0 then answer=str(carry)+answer
    
    return answer
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
insert(answer,".",decpos)
  answer=thepoint+zeros+answer
If dpflag="raw" Then
    answer=Mid(answer,1,decimal_places)
    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
     answer=String(Len(zeros)+runlength+10,"0")
    If dpflag="raw" Then 
        runlength=1
        answer=String(Len(zeros)+runlength+10,"0")
        If decimal_places>Len(zeros) Then
            runlength=runlength+(decimal_places-Len(zeros))
            answer=String(Len(zeros)+runlength+10,"0")
            End If
            End If

Else
decimal_places=decimal_places+decpos
runlength=decimal_places
answer=String(Len(zeros)+runlength+10,"0")
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
       answer[runcount-1]=count+47
       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
       answer=Rtrim(answer,"0")
       answer=Rtrim(answer,".")
       answer=Ltrim(answer,"0")
       If answer="" Then Return "0"
   Return sign+answer
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
            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
'===============================================================================
'===============================================================================
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
'===============================================================================
'===============================================================================

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

Re: Squares

Post by albert »

@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 )
        answer = left(answer,len(answer)-1)
    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
'=================================================
'alberts addition function
'=================================================
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)
    
    answer = string(len1,"0")
    carry=0
    
    dim as ulongint l1,l2,la
    l1=len(num1)-1
    l2=len(num2)-1
    la=len(answer)-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
    
    if carry>0 then answer=str(carry)+answer
    
    return answer
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
insert(answer,".",decpos)
  answer=thepoint+zeros+answer
If dpflag="raw" Then
    answer=Mid(answer,1,decimal_places)
    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
     answer=String(Len(zeros)+runlength+10,"0")
    If dpflag="raw" Then 
        runlength=1
        answer=String(Len(zeros)+runlength+10,"0")
        If decimal_places>Len(zeros) Then
            runlength=runlength+(decimal_places-Len(zeros))
            answer=String(Len(zeros)+runlength+10,"0")
            End If
            End If

Else
decimal_places=decimal_places+decpos
runlength=decimal_places
answer=String(Len(zeros)+runlength+10,"0")
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
       answer[runcount-1]=count+47
       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
       answer=Rtrim(answer,"0")
       answer=Rtrim(answer,".")
       answer=Ltrim(answer,"0")
       If answer="" Then Return "0"
   Return sign+answer
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
            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
'===============================================================================
'===============================================================================
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
'===============================================================================
'===============================================================================

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

Re: Squares

Post by albert »

@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: 3096
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Post by Richard »

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: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@Richard

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

Re: Squares

Post by Richard »

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: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@Richard

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

Re: Squares

Post by dodicat »

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
    Dim As Ubyte addup=Any,addcarry
    #macro finish()
    Return Ltrim(answer,"0")
    #endmacro
    If Len(num2)>Len(num1) Then  Swap num2,num1
    Var diff=Len(num1)-Len(num2)
    Var answer="0"+num1
    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()
    End If
    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 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
              
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Squares

Post by badidea »

print bin(val("5")) ?

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

Re: Squares

Post by albert »

@Dodicat

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

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

Re: Squares

Post by albert »

@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: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@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?
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Squares

Post by badidea »

Like so?

Code: Select all

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

Re: Squares

Post by albert »

@badidea

I need to convert long strings of decimals to base2 and base2 back into base10

like a string of 1,000,000 decimal digits converted to base2..
Locked