Squares

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

Re: Squares

Postby albert » Dec 10, 2018 23:17

@Dodicat
@Richard

I got it working from 1 digit to 1,000 digits.... 1,000 digit time is .22 to .25 seconds with ushort ptr's
Now to make it ulongint ptr's and step by 16's or 18's

Code: Select all

 

DECLARE FUNCTION multiplier_7(byref num1 as string, byref num2 as string) as string
Declare Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") 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 convert_to_pointers( n as string ) as string
declare function make_equal( n as string) as string
declare function less_great ( n1 as string , n2 as string) as string

screen 19

dim as double time1 , time2

dim as longint size1 = 100
dim as longint size2 = 100   

dim as longint total = 0
dim as longint r_correct = 0

do
   
    total+=1
   
    dim as string num1
    for a as longint =  1 to size1 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 string num2
    for a as longint =  1 to size2 step 1
        num2+=str(int(rnd*10))
    next
    if left(num2,1) = "0" then mid(num2,1,1) = str(int(rnd*9)+1)
   
    if len(num2) = len(num1) then if num2 > num1 then swap num1 , num2
    if len(num2) > len(num1) then swap num1 , num2
    if len(num2) = len(num1) then if val(left(num2,1)) > val(left(num1,1)) then swap num1,num2
   
    '==========================================================
    'declare vars
    '==========================================================
    time1 = timer
   
    dim as string test = num2
   
    dim as string l_bot = left(num2,1) + string( len(num2) - 1 , "0" )
    dim as string l_avg
    dim as string l_top =  plus( l_bot , l_bot )
   
    dim as string r_bot  = multiplier_7( num1 , left(num2,1) )
        r_bot = left( r_bot , len(r_bot) - 1 )
        r_bot+= string( len(num2)-1 , "0" )
    dim as string r_avg
    dim as string r_top  = plus( r_bot , r_bot )
       
    dim as string point_5 = half( num1 )
        if right(point_5 , 2 ) = ".5" then point_5 = left( point_5 , len(point_5) - 2 )
       
    '==========================================================
    'make all var strings a multiple of 18 digits
    '==========================================================
    test = make_equal( test )
   
    l_bot  = make_equal( l_bot )
    l_top  = make_equal( l_top )

    r_bot   = make_equal( r_bot )
    r_top   = make_equal( r_top )
   
    point_5 = make_equal( point_5 )
   
    '==========================================================
    'convert the numeric strings to use pointers
    '==========================================================
    test = convert_to_pointers( test )
   
    l_bot = convert_to_pointers( l_bot )
    l_top = convert_to_pointers( l_top )
   
    r_bot = convert_to_pointers( r_bot )
    r_top = convert_to_pointers( r_top )
   
    if len(l_top) > len(l_bot)  then
        l_bot = chr(0) + chr(0) + l_bot
        test   = chr(0) + chr(0) + test
    end if
    if len(r_top) > len(r_bot)  then
        r_bot = chr(0) + chr(0) + r_bot
    end if

    l_avg = l_bot
    r_avg = r_bot
   
    point_5 = convert_to_pointers( point_5 )
   
    '==========================================================
    '==========================================================
   
    dim as string char
    dim as ulongint loops = 0
    do
       
        if l_bot = test then
            l_avg = l_bot
            r_avg = r_bot
            exit do
        end if
        if l_top = test then
            l_avg = l_top
            r_avg = r_top
            exit do
        end if
       
        loops+=1
       
        dim as string l_check = l_avg
        l_avg = string( len(l_top) , chr(0) )
        dim as ushort l_val = 0
        dim as ubyte l_frac = 0
        dim as ushort ptr lt_ptr  = cptr( ushort ptr , strptr( l_top ) )
        dim as ushort ptr la_ptr = cptr( ushort ptr , strptr( l_avg ) )
        dim as ushort ptr lb_ptr = cptr( ushort ptr , strptr( l_bot ) )
            for a as longint = 1 to len( l_avg) step 2
               
                l_val = ( *lt_ptr + *lb_ptr )
                *la_ptr+= ( l_val shr 1 )
               
                if *la_ptr > 9999 then *la_ptr-= 10000 : *(la_ptr-1)+= 1
               
                l_frac = l_val  and 1
                if  a < len(l_avg) then if l_frac = 1 then *(la_ptr+1)+= 5000
               
                lt_ptr+=1
                la_ptr+=1
                lb_ptr+=1
            next
            if l_frac = 1 then  *(la_ptr-1)+= 1
            dim as longint l_place = 1
            for a as longint = len(l_avg) to 2  step -2
                if *(la_ptr-l_place) > 9999 then *(la_ptr-l_place)-=10000 : *(la_ptr-l_place-1)+=1
                l_place+=1
            next
       
           
        dim as string r_check = r_avg
        r_avg = string( len(r_top) , chr(0) )
        dim as ushort r_val = 0
        dim as ubyte r_frac = 0
        dim as ushort ptr rt_ptr  = cptr( ushort ptr , strptr(r_top ) )
        dim as ushort ptr ra_ptr = cptr( ushort ptr , strptr( r_avg ) )
        dim as ushort ptr rb_ptr = cptr( ushort ptr , strptr( r_bot ) )
            for a as longint = 1 to len( r_avg)  step 2
               
                r_val = ( *rt_ptr + *rb_ptr )
                *ra_ptr+= ( r_val shr 1 )
               
                if *ra_ptr > 9999 then *ra_ptr-= 10000 : *(ra_ptr-1)+= 1
               
                r_frac = r_val  and 1
                if  a < len(r_avg) then if r_frac = 1 then *(ra_ptr+1)+= 5000
               
                rt_ptr+=1
                ra_ptr+=1
                rb_ptr+=1
            next
            if r_frac = 1 then *(ra_ptr-1)+=1
            dim as longint r_place = 1
            for a as longint = len(r_avg) to 2  step -2
                if *(ra_ptr-r_place) > 9999 then *(ra_ptr-r_place)-=10000 : *(ra_ptr-r_place-1)+=1
                r_place+=1
            next
           
           
            if l_frac = 1 then
                dim as ushort ptr ubp = cptr( ushort ptr , strptr( point_5 ) + len(point_5) - 2 )
                dim as longint place = 1
                for a as longint = len(point_5) to 2 step -2
                    *(ra_ptr-place)+=*ubp
                    ubp-=1
                    place+=1
                 next
                dim as longint r_place = 1
                for a as longint = len(r_avg) to 2  step -2
                    if *(ra_ptr-r_place) > 9999 then *(ra_ptr-r_place)-=10000 : *(ra_ptr-r_place-1)+=1
                    r_place+=1
                next
            end if
       
        if l_avg = test then exit do else char = less_great( l_avg , test )
       
        if char = ">" then l_top = l_avg : r_top = r_avg
        if char = "<" then l_bot = l_avg : r_bot = r_avg
       
        if inkey = " " then exit do
       
     loop
   
   
    dim as ushort ptr lavg_ptr = cptr( ushort ptr , strptr(l_avg) )
    dim as string l_ans = ""
    for a as longint = 1 to len(l_avg) step 2
            l_ans+= right(string(4,"0") +  str( *lavg_ptr ) , 4 )
            lavg_ptr+=1
    next
    l_ans = ltrim( l_ans,"0")
   
    dim as ushort ptr ravg_ptr = cptr( ushort ptr , strptr(r_avg) )
    dim as string r_ans = ""
    for a as longint = 1 to len(r_avg) step 2
            r_ans+= right(string(4,"0") +  str( *ravg_ptr ) , 4 )
            ravg_ptr+=1
    next
    r_ans = ltrim( r_ans,"0")
   
    time2 = timer
   
    dim as string my_answer = ""
    dim as string real_answer = multiplier_7( num1 , num2 )
    real_answer = left( real_answer , len(real_answer)-1 )
   
    dim as string difference1 = minus( l_ans , num2 )
    dim as string difference2 = minus( r_ans , real_answer )
   
    if difference2 = "0" then r_correct+=1
   
    print
    print "n1    = "  ; num1
    print "n2    = "  ; num2
    print "l_ans = " ; l_ans
    print
    print "real ans = "  ; real_answer
    print "my  ans  = " ; r_ans
    print
    print "L diff        =  " ; difference1
    print "R diff       =   " ; difference2
    print
    print "loops = " ; loops  ,, time2-time1 
    print
    print "correct " ; r_correct ; " out of" ; total
   
    if l_ans <> num2 then sleep
    if r_ans <> real_answer then sleep
   
    if inkey = chr(27) then exit do
    if inkey = " " then sleep
   
loop until inkey = chr(27)

sleep
end
'==================================================
'==================================================
function less_great ( n1 as string , n2 as string) as string
        dim as string char = "="
        if n1 = n2 then return char
        dim as ushort ptr ubp1 = cptr( ushort ptr , strptr(n1) )
        dim as ushort ptr ubp2 = cptr( ushort ptr , strptr(n2) )
        for a as longint = 1 to len(n1) step 2
            if *ubp1 > *ubp2 then char = ">" : exit for
            if *ubp1 < *ubp2 then char = "<" : exit for
            ubp1+=1
            ubp2+=1
        next
        return char
end function
'==================================================
'==================================================
function convert_to_pointers( n as string ) as string
   
    dim as string n1 = n
    dim as string n2
    dim as ushort ptr ubp
    dim as ushort val1
    dim as longint len_1
   
    n2 = string( len(n1) * 4 , chr(0) )
    ubp = cptr( ushort ptr , strptr( n2 ) )
    len_1 = 0
    for a as longint = 0 to len(n1)-1 step 4
        val1  =  (n1[a+0]-48)*1000
        val1+=  (n1[a+1]-48)*100
        val1+=  (n1[a+2]-48)*10
        val1+=  (n1[a+3]-48)*1
        *ubp = val1
        ubp+=1
        len_1+= 2
    next
    n2 = left( n2 , len_1 )
    return n2
end function
'==================================================
'==================================================
function make_equal( n as string) as string
    dim as string n1 = n
    dim as string str1
    dim as ulongint dec1
    do
        str1 = str( len(n1) / 4 )
        dec1 = instr(1,str1,".")
        if  dec1 <> 0 then n1 = "0" + n1
    loop until dec1 = 0
    return n1
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: 5676
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Dec 11, 2018 3:11

@Dodicat
@Richard

It's too slow....compared to mul_loop_7 , it's 100 times slower....

Code: Select all


Declare function mul_loop_7( num1 as string , num2 as string ) as string
Declare Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") 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 convert_to_pointers( n as string ) as string
declare function make_equal( n as string) as string
declare function less_great ( n1 as string , n2 as string) as string

screen 19

dim as double time1 , time2 , time3 , time4

dim as longint size1 = 10000
dim as longint size2 = 10000

dim as longint total = 0
dim as longint r_correct = 0

do
   
    total+=1
   
    dim as string num1
    for a as longint =  1 to size1 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 string num2
    for a as longint =  1 to size2 step 1
        num2+=str(int(rnd*10))
    next
    if left(num2,1) = "0" then mid(num2,1,1) = str(int(rnd*9)+1)
   
    if len(num2) = len(num1) then if num2 > num1 then swap num1 , num2
    if len(num2) > len(num1) then swap num1 , num2
    if len(num2) = len(num1) then if val(left(num2,2)) > val(left(num1,2)) then swap num1,num2
   
    '==========================================================
    'declare vars
    '==========================================================
    time1 = timer
   
    dim as string test = num2
   
    dim as string l_bot = left(num2,1) + string( len(num2) - 1 , "0" )
    dim as string l_avg
    dim as string l_top =  plus( l_bot , l_bot )
   
    dim as string r_bot  = mul_loop_7( num1 , left(num2,1) )
        r_bot+= string( len(num2) - 1   , "0" )
    dim as string r_avg
    dim as string r_top  = plus( r_bot , r_bot )
       
    dim as string point_5 = half( num1 )
        if right(point_5 , 2 ) = ".5" then point_5 = left( point_5 , len(point_5) - 2 )
       
    '==========================================================
    'make all var strings a multiple of 18 digits
    '==========================================================
    test = make_equal( test )
   
    l_bot  = make_equal( l_bot )
    l_top  = make_equal( l_top )

    r_bot   = make_equal( r_bot )
    r_top   = make_equal( r_top )
   
    point_5 = make_equal( point_5 )
   
    '==========================================================
    'convert the numeric strings to use pointers
    '==========================================================
    test = convert_to_pointers( test )
   
    l_bot = convert_to_pointers( l_bot )
    l_top = convert_to_pointers( l_top )
   
    r_bot = convert_to_pointers( r_bot )
    r_top = convert_to_pointers( r_top )
   
   
    if len(l_top)-len(l_bot) > 0 then
        l_bot = string(8,chr(0)) + l_bot
    end if
   
    if len(r_top)-len(r_bot) > 0 then
        r_bot = string(8,chr(0)) + r_bot
    end if
   
    l_avg = l_bot
    r_avg = r_bot
   
    point_5 = convert_to_pointers( point_5 )
   
    '==========================================================
    '==========================================================
   
    dim as string char
    dim as ulongint loops = 0
    do
       
        if l_avg = test then exit do
        if l_bot = test then
            l_avg = l_bot
            r_avg = r_bot
            exit do
        end if
        if l_top = test then
            l_avg = l_top
            r_avg = r_top
            exit do
        end if
       
        loops+=1
       
        l_avg = string( len(l_top) , chr(0) )
        dim as ulongint l_val = 0
        dim as ubyte l_frac = 0
        dim as ulongint ptr lt_ptr  = cptr( ulongint ptr , strptr( l_top ) )
        dim as ulongint ptr la_ptr = cptr( ulongint ptr , strptr( l_avg ) )
        dim as ulongint ptr lb_ptr = cptr( ulongint ptr , strptr( l_bot ) )
            for a as longint = 1 to len( l_avg) step 8
               
                if l_frac = 1 then *la_ptr = 500000000000000000ull
               
                l_val = ( *lt_ptr + *lb_ptr )
                *la_ptr+= ( l_val shr 1 )
               
                if *la_ptr > 999999999999999999ull then *la_ptr-= 1000000000000000000ull : *(la_ptr-1)+= 1
               
                l_frac = l_val  and 1
               
                lt_ptr+=1
                la_ptr+=1
                lb_ptr+=1
            next
            if l_frac = 1 then  *(la_ptr-1)+= 1
           
        r_avg = string( len(r_top) , chr(0) )
        dim as ulongint r_val = 0
        dim as ubyte r_frac = 0
        dim as ulongint ptr rt_ptr  = cptr( ulongint ptr , strptr(r_top ) )
        dim as ulongint ptr ra_ptr = cptr( ulongint ptr , strptr( r_avg ) )
        dim as ulongint ptr rb_ptr = cptr( ulongint ptr , strptr( r_bot ) )
            for a as longint = 1 to len( r_avg)  step 8
               
                if  r_frac = 1 then *ra_ptr = 500000000000000000ull
               
                r_val = ( *rt_ptr + *rb_ptr )
                *ra_ptr+= ( r_val shr 1 )
               
                if *ra_ptr > 999999999999999999ull then *ra_ptr-= 1000000000000000000ull : *(ra_ptr-1)+= 1
               
                r_frac = r_val  and 1
               
                rt_ptr+=1
                ra_ptr+=1
                rb_ptr+=1
            next
            if r_frac = 1 then  *(ra_ptr-1)+= 1
           
            if l_frac = 1 then
                dim as ulongint ptr ubp = cptr( ulongint ptr , strptr( point_5 ) + len(point_5) - 8 )
                dim as longint place = 1
                for a as longint = len(point_5) to 2 step -8
                    if ubp > 0 then *(ra_ptr-place)+=*ubp
                    if *(ra_ptr-place) > 999999999999999999ull then *(ra_ptr-place)-=1000000000000000000ull : *(ra_ptr-place-1)+=1
                    ubp-=1
                    place+=1
                 next
            end if
       
        if inkey = " " then exit do
       
        if l_avg = test then exit do else char = less_great( l_avg , test )
       
        if char = ">" then l_top = l_avg : r_top = r_avg
        if char = "<" then l_bot = l_avg : r_bot = r_avg
       
    loop
   
    dim as ulongint ptr lavg_ptr = cptr( ulongint ptr , strptr(l_avg) )
    dim as string l_ans = ""
    for a as longint = 1 to len(l_avg) step 8
            l_ans+= right(string(18,"0") +  str( *lavg_ptr ) , 18 )
            lavg_ptr+=1
    next
    l_ans = ltrim( l_ans,"0")
   
    dim as ulongint ptr ravg_ptr = cptr( ulongint ptr , strptr(r_avg) )
    dim as string r_ans = ""
    for a as longint = 1 to len(r_avg) step 8
            r_ans+= right(string(18,"0") +  str( *ravg_ptr ) , 18)
            ravg_ptr+=1
    next
    r_ans = ltrim( r_ans,"0")
   
    time2 = timer
   
    time3 = timer
        dim as string my_answer = ""
        dim as string real_answer = mul_loop_7( num1 , num2 )
    time4 = timer
   
    dim as string difference1 = minus( l_ans , num2 )
    dim as string difference2 = minus( r_ans , real_answer )
   
    if difference2 = "0" then r_correct+=1
   
    print
    print "n1    = "  ; num1
    print "n2    = "  ; num2
    print "l_ans = " ; l_ans
    print
    print "real ans = "  ; real_answer
    print "my  ans  = " ; r_ans
    print
    print "L diff        =  " ; difference1
    print "R diff       =   " ; difference2
    print
    print "loops = " ; loops
    print
    print  "mul time  = " ;  time2-time1
    print "mul 7     = " ; time4-time3
    print
    print "correct " ; r_correct ; " out of" ; total
   
    if l_ans <> num2 then sleep
    if r_ans <> real_answer then sleep
   
    if inkey = chr(27) then exit do
    if inkey = " " then sleep
   
loop until inkey = chr(27)

sleep
end
'==================================================
'==================================================
function less_great ( n1 as string , n2 as string) as string
        dim as string char = "="
        if n1 = n2 then return char
        dim as ulongint ptr ubp1 = cptr( ulongint ptr , strptr(n1) )
        dim as ulongint ptr ubp2 = cptr( ulongint ptr , strptr(n2) )
        for a as longint = 1 to len(n1) step 8
            if *ubp1 > *ubp2 then char = ">" : exit for
            if *ubp1 < *ubp2 then char = "<" : exit for
            ubp1+=1
            ubp2+=1
        next
        return char
end function
'==================================================
'==================================================
function convert_to_pointers( n as string ) as string
   
    dim as string n1 = n
    dim as string n2
    dim as ulongint ptr ubp
    dim as ulongint val1
    dim as longint len_1
   
    n2 = string( len(n1) * 100 , chr(0) )
    ubp = cptr( ulongint ptr , strptr( n2 ) )
    len_1 = 0
    for a as longint = 0 to len(n1)-1 step 18
        val1  =  (n1[a+00]-48)*100000000000000000ull
        val1+=  (n1[a+01]-48)*10000000000000000ull
        val1+=  (n1[a+02]-48)*1000000000000000ull
        val1+=  (n1[a+03]-48)*100000000000000ull
        val1+=  (n1[a+04]-48)*10000000000000ull
        val1+=  (n1[a+05]-48)*1000000000000ull
        val1+=  (n1[a+06]-48)*100000000000ull
        val1+=  (n1[a+07]-48)*10000000000ull
        val1+=  (n1[a+08]-48)*1000000000ull
        val1+=  (n1[a+09]-48)*100000000ull
        val1+=  (n1[a+10]-48)*10000000ull
        val1+=  (n1[a+11]-48)*1000000ull
        val1+=  (n1[a+12]-48)*100000ull
        val1+=  (n1[a+13]-48)*10000ull
        val1+=  (n1[a+14]-48)*1000ull
        val1+=  (n1[a+15]-48)*100ull
        val1+=  (n1[a+16]-48)*10ull
        val1+=  (n1[a+17]-48)*1ull
        *ubp = val1
        ubp+=1
        len_1+= 8
    next
    n2 = left( n2 , len_1 )
    return n2
end function
'==================================================
'==================================================
function make_equal( n as string) as string
    dim as string n1 = n
    dim as string str1
    dim as ulongint dec1
    do
        str1 = str( len(n1) / 18 )
        dec1 = instr(1,str1,".")
        if  dec1 <> 0 then n1 = "0" + n1
    loop until dec1 = 0
    return n1
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 mul_loop_7( num1 as string , num2 as string ) as string
   
    dim as string number1 = num1
    dim as string number2 = num2
   
    'make numbers equal multiple of 7 bytes
    dim as string str1
    dim as longint dec1
    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 = cptr(ulongint ptr,strptr(n1))
    dim as longint valu1
    dim as longint len_1 = 0
    for a as longint = 0 to len(number1)-1 step 7
        valu1  = (number1[a     ]-48)*1e6
        valu1+= (number1[a+1]-48)*1e5
        valu1+= (number1[a+2]-48)*1e4
        valu1+= (number1[a+3]-48)*1e3
        valu1+= (number1[a+4]-48)*1e2
        valu1+= (number1[a+5]-48)*1e1
        valu1+= (number1[a+6]-48)'*1
        *ulp1 = valu1
        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 = cptr(ulongint ptr,strptr(n2))
    dim as longint valu2
    dim as longint len_2 = 0
    for a as longint = 0 to len(number2)-1 step 7
        valu2 =  (number2[a     ]-48)*1e6
        valu2+= (number2[a+1]-48)*1e5
        valu2+= (number2[a+2]-48)*1e4
        valu2+= (number2[a+3]-48)*1e3
        valu2+= (number2[a+4]-48)*1e2
        valu2+= (number2[a+5]-48)*1e1
        valu2+= (number2[a+6]-48)'*1
        *ulp2 = valu2
        ulp2+=1
        len_2+=8
    next
    number2 = left(n2,len_2)
    n2=""
   
    'create accumulator
    dim as string answer = string( len(number1) + len(number2) , chr(0) )
    dim as ulongint outblocks = ( len(answer) \ 8 )
    dim as ulongint ptr outplace = cptr(ulongint ptr , strptr(answer)) + (outblocks - 1 )
    dim as ulongint stops = ( (len(number1)\8) + (len(number2)\8) )
    dim as ulongint value = 0
    dim as longint hold = -1
    dim as longint locat = 0
    dim as longint vals = 0
    dim as ulongint high1 = ( len(number1)  \ 8 ) - 1
    dim as ulongint high2 = ( len(number2)  \ 8 ) - 1
    dim as longint ptr num1_ptr = cptr( ulongint ptr , strptr(number1) ) + high1
    dim as longint ptr num2_ptr = cptr( ulongint ptr , strptr(number2) ) + high2
    do
        hold+=1
        vals = hold
        locat = 0
        if vals > high2 then vals = high2 : locat = (hold - high2)
        num1_ptr = cptr( ulongint ptr , strptr(number1) ) + high1 - locat
        num2_ptr = cptr( ulongint ptr , strptr(number2) ) + high2 - vals
        do
            value+= *( num1_ptr ) * *( num2_ptr )
            num1_ptr-=1
            num2_ptr+=1
            if num1_ptr = cptr( ulongint ptr , strptr(number1) ) - 1 then goto done
            if num2_ptr > cptr( ulongint ptr , strptr(number2) ) + high2  then goto done
        loop
        Done:
        *outplace = value mod 1e7
         outplace-= 1
         value = value \ 1e7
    loop until hold = stops-2
   
     *outplace = value mod 1e7
       
    'convert answer back to ascii
   dim as string outtext=""
   outplace = cptr( ulongint ptr , strptr(answer) )
   for a as ulongint = 1 to outblocks step 1
       value = *outplace
       outplace+=1
       outtext+= right("0000000" + str(value),7)
    next   
   
   outtext = ltrim(outtext,"0")
   
   return outtext
   
end function
'===============================================================================
'===============================================================================

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

Re: Squares

Postby albert » Dec 11, 2018 17:21

@Dodicat
@Richard

Here's the latest.... takes 3 seconds for 10,000 by 10,000 digits... 100 times slower...

Code: Select all


Declare function mul_loop_7( num1 as string , num2 as string ) as string
Declare Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") 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 convert_to_pointers( n as string ) as string
declare function make_equal( n as string) as string
declare function less_great ( n1 as string , n2 as string) as string

screen 19

dim as double time1 , time2 , time3 , time4

dim as longint size1 = 10000
dim as longint size2 = 10000

dim as longint total = 0
dim as longint r_correct = 0

do
   
    total+=1
   
    dim as string num1
    for a as longint =  1 to size1 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 string num2
    for a as longint =  1 to size2 step 1
        num2+=str(int(rnd*10))
    next
    if left(num2,1) = "0" then mid(num2,1,1) = str(int(rnd*9)+1)
   
    if len(num2) = len(num1) then if num2 > num1 then swap num1 , num2
    if len(num2) > len(num1) then swap num1 , num2
    if len(num2) = len(num1) then if val(left(num2,2)) > val(left(num1,2)) then swap num1,num2
   
    '==========================================================
    'declare vars
    '==========================================================
    time1 = timer
   
    dim as string test = num2
   
    dim as string l_bot = left(num2,1) + string( len(num2) - 1 , "0" )
    dim as string l_avg
    dim as string l_top =  plus( l_bot , l_bot )
   
    dim as string r_bot  = mul_loop_7( num1 , left(num2,1) )
        r_bot+= string( len(num2) - 1   , "0" )
    dim as string r_avg
    dim as string r_top  = plus( r_bot , r_bot )
       
    dim as string point_5 = half( num1 )
        if right(point_5 , 2 ) = ".5" then point_5 = left( point_5 , len(point_5) - 2 )
       
    '==========================================================
    'make all var strings a multiple of 18 digits
    '==========================================================
    test = make_equal( test )
   
    l_bot  = make_equal( l_bot )
    l_top  = make_equal( l_top )

    r_bot   = make_equal( r_bot )
    r_top   = make_equal( r_top )
   
    point_5 = make_equal( point_5 )
   
    '==========================================================
    'convert the numeric strings to use pointers
    '==========================================================
    test = convert_to_pointers( test )
   
    l_bot = convert_to_pointers( l_bot )
    l_top = convert_to_pointers( l_top )
   
    r_bot = convert_to_pointers( r_bot )
    r_top = convert_to_pointers( r_top )
   
   
    if len(l_top)-len(l_bot) > 0 then
        l_bot = string(8,chr(0)) + l_bot
    end if
   
    if len(r_top)-len(r_bot) > 0 then
        r_bot = string(8,chr(0)) + r_bot
    end if
   
    l_avg = l_bot
    r_avg = r_bot
   
    point_5 = convert_to_pointers( point_5 )
   
    '==========================================================
    '==========================================================
    dim as ulongint l_val
    dim as ubyte l_frac
    dim as ulongint ptr lt_ptr
    dim as ulongint ptr la_ptr
    dim as ulongint ptr lb_ptr
   
    dim as ulongint r_val
    dim as ubyte r_frac
    dim as ulongint ptr rt_ptr
    dim as ulongint ptr ra_ptr
    dim as ulongint ptr rb_ptr
   
    dim as string char
    dim as ulongint loops = 0
    do
       
        if l_avg = test then exit do
       
        if l_bot = test then
            l_avg = l_bot
            r_avg = r_bot
            exit do
        end if
       
        if l_top = test then
            l_avg = l_top
            r_avg = r_top
            exit do
        end if
       
        loops+=1
       
            l_val = 0
            l_frac = 0
            lt_ptr  = cptr( ulongint ptr , strptr( l_top ) )
            la_ptr = cptr( ulongint ptr , strptr( l_avg ) )
            lb_ptr = cptr( ulongint ptr , strptr( l_bot ) )
            for a as longint = 1 to len( l_avg) step 8
                *la_ptr = 0
                if l_frac = 1 then *la_ptr = 500000000000000000ull
                l_val = ( *lt_ptr + *lb_ptr )
                *la_ptr+= ( l_val shr 1 )
                if *la_ptr > 999999999999999999ull then *la_ptr-= 1000000000000000000ull : *(la_ptr-1)+= 1
                l_frac = l_val  and 1
                lt_ptr+=1
                la_ptr+=1
                lb_ptr+=1
            next
            if l_frac = 1 then  *(la_ptr-1)+= 1
           
            r_val = 0
            r_frac = 0
            rt_ptr  = cptr( ulongint ptr , strptr(r_top ) )
            ra_ptr = cptr( ulongint ptr , strptr( r_avg ) )
            rb_ptr = cptr( ulongint ptr , strptr( r_bot ) )
            for a as longint = 1 to len( r_avg)  step 8
                *ra_ptr = 0
                if  r_frac = 1 then *ra_ptr = 500000000000000000ull
                r_val = ( *rt_ptr + *rb_ptr )
                *ra_ptr+= ( r_val shr 1 )
                if *ra_ptr > 999999999999999999ull then *ra_ptr-= 1000000000000000000ull : *(ra_ptr-1)+= 1
                r_frac = r_val  and 1
                rt_ptr+=1
                ra_ptr+=1
                rb_ptr+=1
            next
            if r_frac = 1 then  *(ra_ptr-1)+= 1
           
            if l_frac = 1 then
                dim as ulongint ptr ubp = cptr( ulongint ptr , strptr( point_5 ) + len(point_5) - 8 )
                dim as longint place = 1
                for a as longint = len(point_5) to 8 step -8
                    if ubp > 0 then *(ra_ptr-place)+=*ubp
                    if *(ra_ptr-place) > 999999999999999999ull then *(ra_ptr-place)-=1000000000000000000ull : *(ra_ptr-place-1)+=1
                    ubp-=1
                    place+=1
                 next
            end if
       
        if inkey = " " then exit do
       
        if l_avg = test then exit do else char = less_great( l_avg , test )
       
        if char = ">" then l_top = l_avg : r_top = r_avg
         if char = "<" then l_bot = l_avg : r_bot = r_avg
       
    loop
   
    dim as ulongint ptr lavg_ptr = cptr( ulongint ptr , strptr(l_avg) )
    dim as string l_ans = ""
    for a as longint = 1 to len(l_avg) step 8
            l_ans+= right(string(18,"0") +  str( *lavg_ptr ) , 18 )
            lavg_ptr+=1
    next
    l_ans = ltrim( l_ans,"0")
   
    dim as ulongint ptr ravg_ptr = cptr( ulongint ptr , strptr(r_avg) )
    dim as string r_ans = ""
    for a as longint = 1 to len(r_avg) step 8
            r_ans+= right(string(18,"0") +  str( *ravg_ptr ) , 18)
            ravg_ptr+=1
    next
    r_ans = ltrim( r_ans,"0")
   
    time2 = timer
   
    time3 = timer
        dim as string my_answer = ""
        dim as string real_answer = mul_loop_7( num1 , num2 )
    time4 = timer
   
    dim as string difference1 = minus( l_ans , num2 )
    dim as string difference2 = minus( r_ans , real_answer )
   
    if difference2 = "0" then r_correct+=1
   
    print
    print "n1    = "  ; num1
    print "n2    = "  ; num2
    print "l_ans = " ; l_ans
    print
    print "real ans = "  ; real_answer
    print "my  ans  = " ; r_ans
    print
    print "L diff        =  " ; difference1
    print "R diff        =  " ; difference2
    print
    print "loops = " ; loops
    print
    print  "avg  time  = " ;  time2-time1
    print "mul 7      = " ; time4-time3
    print
    print "correct " ; r_correct ; " out of" ; total
   
    if l_ans <> num2 then sleep
    if r_ans <> real_answer then sleep
   
    if inkey = chr(27) then exit do
    if inkey = " " then sleep
   
loop until inkey = chr(27)

sleep
end
'==================================================
'==================================================
function less_great ( n1 as string , n2 as string) as string
        dim as string char = "="
        if n1 = n2 then return char
        dim as ulongint ptr ubp1 = cptr( ulongint ptr , strptr(n1) )
        dim as ulongint ptr ubp2 = cptr( ulongint ptr , strptr(n2) )
        for a as longint = 1 to len(n1) step 8
            if *ubp1 > *ubp2 then char = ">" : exit for
            if *ubp1 < *ubp2 then char = "<" : exit for
            ubp1+=1
            ubp2+=1
        next
        return char
end function
'==================================================
'==================================================
function convert_to_pointers( n as string ) as string
   
    dim as string n1 = n
    dim as string n2
    dim as ulongint ptr ubp
    dim as ulongint val1
    dim as longint len_1
   
    n2 = string( len(n1) * 100 , chr(0) )
    ubp = cptr( ulongint ptr , strptr( n2 ) )
    len_1 = 0
    for a as longint = 0 to len(n1)-1 step 18
        val1  =  (n1[a+00]-48)*100000000000000000ull
        val1+=  (n1[a+01]-48)*10000000000000000ull
        val1+=  (n1[a+02]-48)*1000000000000000ull
        val1+=  (n1[a+03]-48)*100000000000000ull
        val1+=  (n1[a+04]-48)*10000000000000ull
        val1+=  (n1[a+05]-48)*1000000000000ull
        val1+=  (n1[a+06]-48)*100000000000ull
        val1+=  (n1[a+07]-48)*10000000000ull
        val1+=  (n1[a+08]-48)*1000000000ull
        val1+=  (n1[a+09]-48)*100000000ull
        val1+=  (n1[a+10]-48)*10000000ull
        val1+=  (n1[a+11]-48)*1000000ull
        val1+=  (n1[a+12]-48)*100000ull
        val1+=  (n1[a+13]-48)*10000ull
        val1+=  (n1[a+14]-48)*1000ull
        val1+=  (n1[a+15]-48)*100ull
        val1+=  (n1[a+16]-48)*10ull
        val1+=  (n1[a+17]-48)*1ull
        *ubp = val1
        ubp+=1
        len_1+= 8
    next
    n2 = left( n2 , len_1 )
    return n2
end function
'==================================================
'==================================================
function make_equal( n as string) as string
    dim as string n1 = n
    dim as string str1
    dim as ulongint dec1
    do
        str1 = str( len(n1) / 18 )
        dec1 = instr(1,str1,".")
        if  dec1 <> 0 then n1 = "0" + n1
    loop until dec1 = 0
    return n1
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 mul_loop_7( num1 as string , num2 as string ) as string
   
    dim as string number1 = num1
    dim as string number2 = num2
   
    'make numbers equal multiple of 7 bytes
    dim as string str1
    dim as longint dec1
    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 = cptr(ulongint ptr,strptr(n1))
    dim as longint valu1
    dim as longint len_1 = 0
    for a as longint = 0 to len(number1)-1 step 7
        valu1  = (number1[a     ]-48)*1e6
        valu1+= (number1[a+1]-48)*1e5
        valu1+= (number1[a+2]-48)*1e4
        valu1+= (number1[a+3]-48)*1e3
        valu1+= (number1[a+4]-48)*1e2
        valu1+= (number1[a+5]-48)*1e1
        valu1+= (number1[a+6]-48)'*1
        *ulp1 = valu1
        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 = cptr(ulongint ptr,strptr(n2))
    dim as longint valu2
    dim as longint len_2 = 0
    for a as longint = 0 to len(number2)-1 step 7
        valu2 =  (number2[a     ]-48)*1e6
        valu2+= (number2[a+1]-48)*1e5
        valu2+= (number2[a+2]-48)*1e4
        valu2+= (number2[a+3]-48)*1e3
        valu2+= (number2[a+4]-48)*1e2
        valu2+= (number2[a+5]-48)*1e1
        valu2+= (number2[a+6]-48)'*1
        *ulp2 = valu2
        ulp2+=1
        len_2+=8
    next
    number2 = left(n2,len_2)
    n2=""
   
    'create accumulator
    dim as string answer = string( len(number1) + len(number2) , chr(0) )
    dim as ulongint outblocks = ( len(answer) \ 8 )
    dim as ulongint ptr outplace = cptr(ulongint ptr , strptr(answer)) + (outblocks - 1 )
    dim as ulongint stops = ( (len(number1)\8) + (len(number2)\8) )
    dim as ulongint value = 0
    dim as longint hold = -1
    dim as longint locat = 0
    dim as longint vals = 0
    dim as ulongint high1 = ( len(number1)  \ 8 ) - 1
    dim as ulongint high2 = ( len(number2)  \ 8 ) - 1
    dim as longint ptr num1_ptr = cptr( ulongint ptr , strptr(number1) ) + high1
    dim as longint ptr num2_ptr = cptr( ulongint ptr , strptr(number2) ) + high2
    do
        hold+=1
        vals = hold
        locat = 0
        if vals > high2 then vals = high2 : locat = (hold - high2)
        num1_ptr = cptr( ulongint ptr , strptr(number1) ) + high1 - locat
        num2_ptr = cptr( ulongint ptr , strptr(number2) ) + high2 - vals
        do
            value+= *( num1_ptr ) * *( num2_ptr )
            num1_ptr-=1
            num2_ptr+=1
            if num1_ptr = cptr( ulongint ptr , strptr(number1) ) - 1 then goto done
            if num2_ptr > cptr( ulongint ptr , strptr(number2) ) + high2  then goto done
        loop
        Done:
        *outplace = value mod 1e7
         outplace-= 1
         value = value \ 1e7
    loop until hold = stops-2
   
     *outplace = value mod 1e7
       
    'convert answer back to ascii
   dim as string outtext=""
   outplace = cptr( ulongint ptr , strptr(answer) )
   for a as ulongint = 1 to outblocks step 1
       value = *outplace
       outplace+=1
       outtext+= right("0000000" + str(value),7)
    next   
   
   outtext = ltrim(outtext,"0")
   
   return outtext
   
end function
'===============================================================================
'===============================================================================

Richard
Posts: 3013
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » Dec 11, 2018 21:15

@Albert. Even though we would all like to be clairvoyant mind readers, we are human. Without meaningful documentation you are alone and we cannot help.

If you clearly described your algorithm, a good mathematician could show how fast it would be, or if it was impossible, long before you got bogged down in muddy code. The longer you work on your code, the slower it runs, the bigger and the more confusing it gets, and the more you celebrate the miracle that it seems to work at all, even if it is really slow.

I can't tell what is your new code and what are the tested functions included to help. Try including a couple of paragraphs of documentation in your code. Describe the data input and output format, with examples and exceptions. Describe the internal data format you will use. Then describe the way your algorithm will work on that data. When you write your code, over-document it so you and others can follow what you are doing.

Meanwhile, I will watch as you gradually make your heap of code thicker and slower, until it evolves into really creepy code. I am expecting to find mud crabs living amongst the mangrove roots in your code.
bfuller
Posts: 337
Joined: Jun 02, 2007 12:35
Location: Sydney, Australia

Re: Squares

Postby bfuller » Dec 11, 2018 23:06

Ha Ha. I still lurk occasionally and the above brought a smile to my face.

I have been working with National Instruments Labview lately and have paid for the full license. I had a paid customer project to deliver so I could justify the license (very expensive), but the customer specifically wanted a "professional" development system and not open source, so thats what I did. Anyway, it is a very nice system and the student version (or even the trial version) is worth having a play with if you are keen. The learning curve is quite steep, but once you learn how to climb then the capability is very extensive. I fully understand that the sort of visual/graphical programming technique results in bloated code but for me the time from concept to running code is very short. Text based coding is very good for a quick algorithm or concept test, but I always have trouble with text based coding once the code gets more than a couple pages long (sad face!). Graphical coding helps me because all the tough work of making the HMI very smooth and slick looking is already done, even if the end result is Multi MBytes.

FreeBasic still runs in my veins. In fact, Labview can call other code and a hybrid solution is entirely possible if I hit a speed wall or really need to get directly at hardware rather that hiding behind a USB interface or something.
albert
Posts: 5676
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Dec 12, 2018 0:38

@Richard

The workings of the "AVERAGER"

n1 = 7
n2 = 3

l_bot = 3
l_avg = l_bot = 3
l_top = l_bot + l_bot = 6

r_bot = n1 * left( n2, 1 ) = (21)
r_bot+= string( len(n2)-1,"0") = (21 in this case)
r_avg = r_bot = 21
r_top = r_bot + r_bot = 42

then you loop
averaging l_top , l_bot and assign the average to l_avg
averaging r_top , r_bot and assign the average to r_avg

if l_avg > n2 then l_top = l_avg : r_top = r_avg : lower the tops
if l_avg < n2 then l_bot = l_avg : r_bot = r_avg : raise the bottoms

If the average of l_top , l_bot ends in .5 fraction then
you add .5 to l_avg
you add half of n1 to r_avg ( 3 ) int half of 7

you keep looping till l_avg = n2

when l_avg = n2 then r_avg will equal the result of the mul...

It works out to:
each value on the left ( l_top - l_bot) = ( (l_top - l_bot) * n1) on the right side
==========================================================================
in the above case , it will keep lowering the tops , until they equal the bottoms, and return the bottoms.
I got the code set to skip the averaging if l_bot , l_avg = n2 in that case r_bot , r_avg = mul result
==========================================================================

Here's the latest:

Code: Select all


Declare function mul_loop_7( num1 as string , num2 as string ) as string
Declare Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") 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 convert_to_pointers( n as string ) as string
declare function less_great ( n1 as string , n2 as string) as string

screen 19

dim as double time1 , time2 , time3 , time4

dim as longint size1 = 1000
dim as longint size2 = 1000

dim as longint total = 0
dim as longint r_correct = 0

do
   
    total+=1
   
    dim as string num1
    for a as longint =  1 to size1 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 string num2
    for a as longint =  1 to size2 step 1
        num2+=str(int(rnd*10))
    next
    if left(num2,1) = "0" then mid(num2,1,1) = str(int(rnd*9)+1)
   
    if len(num2) = len(num1) then if num2 > num1 then swap num1 , num2
    if len(num2) > len(num1) then swap num1 , num2
    if len(num2) = len(num1) then if val(left(num2,2)) > val(left(num1,2)) then swap num1,num2
   
    '==========================================================
    'declare vars
    '==========================================================
    time1 = timer
   
    dim as string test = num2
   
    dim as string l_bot = left(num2,1) + string( len(num2) - 1 , "0" )
    dim as string l_avg
    dim as string l_top =  plus( l_bot , l_bot )
   
    dim as string r_bot  = mul_loop_7( num1 , left(num2,1) )
        r_bot+= string( len(num2) - 1   , "0" )
    dim as string r_avg
    dim as string r_top  = plus( r_bot , r_bot )
       
    dim as string point_5 = half( num1 )
        if right(point_5 , 2 ) = ".5" then point_5 = left( point_5 , len(point_5) - 2 )
       
    '==========================================================
    'convert the numeric strings to use pointers
    '==========================================================
    test = convert_to_pointers( test )
   
    l_bot = convert_to_pointers( l_bot )
    l_top = convert_to_pointers( l_top )
   
    r_bot = convert_to_pointers( r_bot )
    r_top = convert_to_pointers( r_top )
   
   
    if len(l_top)-len(l_bot) > 0 then
        l_bot = string(8,chr(0)) + l_bot
    end if
   
    if len(r_top)-len(r_bot) > 0 then
        r_bot = string(8,chr(0)) + r_bot
    end if
   
    l_avg = l_bot
    r_avg = r_bot
   
    point_5 = convert_to_pointers( point_5 )
   
    '==========================================================
    '==========================================================
    dim as ulongint l_val
    dim as ubyte l_frac
    dim as ulongint ptr lt_ptr
    dim as ulongint ptr la_ptr
    dim as ulongint ptr lb_ptr
     
    dim as ulongint r_val
    dim as ubyte r_frac
    dim as ulongint ptr rt_ptr
    dim as ulongint ptr ra_ptr
    dim as ulongint ptr rb_ptr
   
    dim as ulongint nines = 999999999999999999ull
    dim as ulongint halfs  = 500000000000000000ull
    dim as ulongint tens  = 1000000000000000000ull
   
    dim as string char
    dim as ulongint loops = 0
    do
       
        if l_avg = test then exit do
       
        loops+=1
       
            l_frac = 0
            lt_ptr   = cptr( ulongint ptr , strptr( l_top ) )
            la_ptr = cptr( ulongint ptr , strptr( l_avg ) )
            lb_ptr = cptr( ulongint ptr , strptr( l_bot ) )
            for a as longint = 1 to len( l_avg) step 8
                if l_frac = 1 then *la_ptr = halfs else *la_ptr = 0
                l_val = ( *lt_ptr + *lb_ptr )
                *la_ptr+= ( l_val \ 2 )
                if *la_ptr > nines then *la_ptr-= tens : *(la_ptr-1)+= 1
                l_frac = (l_val and 1)
                lt_ptr+=1
                la_ptr+=1
                lb_ptr+=1
            next
            if l_frac = 1 then  *(la_ptr-1)+= 1
           
            r_frac = 0
            rt_ptr   = cptr( ulongint ptr , strptr(r_top ) )
            ra_ptr = cptr( ulongint ptr , strptr( r_avg ) )
            rb_ptr = cptr( ulongint ptr , strptr( r_bot ) )
            for a as longint = 1 to len( r_avg)  step 8
                if  r_frac = 1 then *ra_ptr = halfs else *ra_ptr = 0
                r_val = ( *rt_ptr + *rb_ptr )
                *ra_ptr+= ( r_val \ 2 )
                if *ra_ptr > nines then *ra_ptr-= tens : *(ra_ptr-1)+= 1
                r_frac = r_val  and 1
                rt_ptr+=1
                ra_ptr+=1
                rb_ptr+=1
            next
            if r_frac = 1 then  *(ra_ptr-1)+= 1
           
            if l_frac = 1 then
                dim as ulongint ptr ubp = cptr( ulongint ptr , strptr( point_5 ) + len(point_5) - 8 )
                dim as longint place = 1
                for a as longint = len(point_5) to 8 step -8
                    if ubp > 0 then *(ra_ptr-place)+=*ubp
                    if *(ra_ptr-place) > nines then *(ra_ptr-place)-= tens : *(ra_ptr-place-1)+=1
                    ubp-=1
                    place+=1
                 next
            end if
       
        if l_avg = test then exit do
       
        char = less_great( l_avg , test )
       
        if char = ">" then
            l_top = l_avg
            r_top = r_avg
        else
            l_bot = l_avg
            r_bot = r_avg
       end if
       
       if inkey = " " then exit do
       
    loop
   
    dim as ulongint ptr lavg_ptr = cptr( ulongint ptr , strptr(l_avg) )
    dim as string l_ans = ""
    for a as longint = 1 to len(l_avg) step 8
            l_ans+= right(string(18,"0") +  str( *lavg_ptr ) , 18 )
            lavg_ptr+=1
    next
    l_ans = ltrim( l_ans,"0")
   
    dim as ulongint ptr ravg_ptr = cptr( ulongint ptr , strptr(r_avg) )
    dim as string r_ans = ""
    for a as longint = 1 to len(r_avg) step 8
            r_ans+= right(string(18,"0") +  str( *ravg_ptr ) , 18)
            ravg_ptr+=1
    next
    r_ans = ltrim( r_ans,"0")
   
    time2 = timer
   
    time3 = timer
        dim as string my_answer = ""
        dim as string real_answer = mul_loop_7( num1 , num2 )
    time4 = timer
   
    dim as string difference1 = minus( l_ans , num2 )
    dim as string difference2 = minus( r_ans , real_answer )
   
    if difference2 = "0" then r_correct+=1
   
    print
    print "n1    = "  ; num1
    print "n2    = "  ; num2
    print "l_ans = " ; l_ans
    print
    print "real ans = "  ; real_answer
    print "my  ans  = " ; r_ans
    print
    print "L diff        =  " ; difference1
    print "R diff        =  " ; difference2
    print
    print "loops = " ; loops
    print
    print  "avg  time  = " ;  time2-time1
    print "mul 7      = " ; time4-time3
    print
    print "correct " ; r_correct ; " out of" ; total
   
    if l_ans <> num2 then sleep
    if r_ans <> real_answer then sleep
   
    if inkey = chr(27) then exit do
    if inkey = " " then sleep
   
loop until inkey = chr(27)

sleep
sleep
end
'==================================================
'==================================================
function less_great ( n1 as string , n2 as string) as string
        dim as ulongint ptr ubp1 = cptr( ulongint ptr , strptr(n1) )
        dim as ulongint ptr ubp2 = cptr( ulongint ptr , strptr(n2) )
        dim as ulongint val1
        dim as ulongint val2
        dim as longint p = 0
        for a as longint = 1 to len(n1) step 8
            val1 = *(ubp1+p)
            val2 = *(ubp2+p)
            if val1 <> val2 then if val1 > val2 then return ">" else return "<"
            p+= 1
         next
end function
'==================================================
'==================================================
function convert_to_pointers( n as string ) as string

    dim as string n1 = n
   
    dim as string str1
    dim as ulongint dec1
    do
        str1 = str( len(n1) / 18 )
        dec1 = instr(1,str1,".")
        if  dec1 <> 0 then n1 = "0" + n1
    loop until dec1 = 0

    dim as string n2
    dim as ulongint ptr ubp
    dim as ulongint val1
    dim as longint len_1
   
    n2 = string( len(n1) * 10 , chr(0) )
    ubp = cptr( ulongint ptr , strptr( n2 ) )
    len_1 = 0
    for a as longint = 0 to len(n1)-1 step 18
        val1  =  (n1[a+00]-48)*100000000000000000ull
        val1+=  (n1[a+01]-48)*10000000000000000ull
        val1+=  (n1[a+02]-48)*1000000000000000ull
        val1+=  (n1[a+03]-48)*100000000000000ull
        val1+=  (n1[a+04]-48)*10000000000000ull
        val1+=  (n1[a+05]-48)*1000000000000ull
        val1+=  (n1[a+06]-48)*100000000000ull
        val1+=  (n1[a+07]-48)*10000000000ull
        val1+=  (n1[a+08]-48)*1000000000ull
        val1+=  (n1[a+09]-48)*100000000ull
        val1+=  (n1[a+10]-48)*10000000ull
        val1+=  (n1[a+11]-48)*1000000ull
        val1+=  (n1[a+12]-48)*100000ull
        val1+=  (n1[a+13]-48)*10000ull
        val1+=  (n1[a+14]-48)*1000ull
        val1+=  (n1[a+15]-48)*100ull
        val1+=  (n1[a+16]-48)*10ull
        val1+=  (n1[a+17]-48)*1ull
        *ubp = val1
        ubp+=1
        len_1+= 8
    next
    n2 = left( n2 , len_1 )
    return n2
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 mul_loop_7( num1 as string , num2 as string ) as string
   
    dim as string number1 = num1
    dim as string number2 = num2
   
    'make numbers equal multiple of 7 bytes
    dim as string str1
    dim as longint dec1
    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 = cptr(ulongint ptr,strptr(n1))
    dim as longint valu1
    dim as longint len_1 = 0
    for a as longint = 0 to len(number1)-1 step 7
        valu1  = (number1[a     ]-48)*1e6
        valu1+= (number1[a+1]-48)*1e5
        valu1+= (number1[a+2]-48)*1e4
        valu1+= (number1[a+3]-48)*1e3
        valu1+= (number1[a+4]-48)*1e2
        valu1+= (number1[a+5]-48)*1e1
        valu1+= (number1[a+6]-48)'*1
        *ulp1 = valu1
        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 = cptr(ulongint ptr,strptr(n2))
    dim as longint valu2
    dim as longint len_2 = 0
    for a as longint = 0 to len(number2)-1 step 7
        valu2 =  (number2[a     ]-48)*1e6
        valu2+= (number2[a+1]-48)*1e5
        valu2+= (number2[a+2]-48)*1e4
        valu2+= (number2[a+3]-48)*1e3
        valu2+= (number2[a+4]-48)*1e2
        valu2+= (number2[a+5]-48)*1e1
        valu2+= (number2[a+6]-48)'*1
        *ulp2 = valu2
        ulp2+=1
        len_2+=8
    next
    number2 = left(n2,len_2)
    n2=""
   
    'create accumulator
    dim as string answer = string( len(number1) + len(number2) , chr(0) )
    dim as ulongint outblocks = ( len(answer) \ 8 )
    dim as ulongint ptr outplace = cptr(ulongint ptr , strptr(answer)) + (outblocks - 1 )
    dim as ulongint stops = ( (len(number1)\8) + (len(number2)\8) )
    dim as ulongint value = 0
    dim as longint hold = -1
    dim as longint locat = 0
    dim as longint vals = 0
    dim as ulongint high1 = ( len(number1)  \ 8 ) - 1
    dim as ulongint high2 = ( len(number2)  \ 8 ) - 1
    dim as longint ptr num1_ptr = cptr( ulongint ptr , strptr(number1) ) + high1
    dim as longint ptr num2_ptr = cptr( ulongint ptr , strptr(number2) ) + high2
    do
        hold+=1
        vals = hold
        locat = 0
        if vals > high2 then vals = high2 : locat = (hold - high2)
        num1_ptr = cptr( ulongint ptr , strptr(number1) ) + high1 - locat
        num2_ptr = cptr( ulongint ptr , strptr(number2) ) + high2 - vals
        do
            value+= *( num1_ptr ) * *( num2_ptr )
            num1_ptr-=1
            num2_ptr+=1
            if num1_ptr = cptr( ulongint ptr , strptr(number1) ) - 1 then goto done
            if num2_ptr > cptr( ulongint ptr , strptr(number2) ) + high2  then goto done
        loop
        Done:
        *outplace = value mod 1e7
         outplace-= 1
         value = value \ 1e7
    loop until hold = stops-2
   
     *outplace = value mod 1e7
       
    'convert answer back to ascii
   dim as string outtext=""
   outplace = cptr( ulongint ptr , strptr(answer) )
   for a as ulongint = 1 to outblocks step 1
       value = *outplace
       outplace+=1
       outtext+= right("0000000" + str(value),7)
    next   
   
   outtext = ltrim(outtext,"0")
   
   return outtext
   
end function
'===============================================================================
'===============================================================================


Last edited by albert on Dec 12, 2018 17:49, edited 1 time in total.
dodicat
Posts: 6487
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Dec 12, 2018 11:32

These huge numbers by Albert exceed the number of atoms in the known universe, including squashed ones in black holes.
Far in excess of swamp crabs and holes in bfuller's boat.
Richard
Posts: 3013
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » Dec 13, 2018 3:36

Albert, it seems to me that, as you are repeatedly halving, examining a bit and conditionally adding, you are actually really doing long multiplication. Only, like making a ship in a bottle, you are doing it in the most difficult and obtuse way that could still possibly work.
I find making ships in bottles to be as inconvenient as being covered in mud, climbing through mangroves while the tide rises bringing with it those old and wise salt water crocodiles. That might also explain my expectation of finding mud crabs in your code. Things are not looking good. I have now developed an irrational fear that your code is also a breeding ground for the Irukandji jellyfish. Maybe I need a holiday.
albert
Posts: 5676
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Dec 14, 2018 0:34

@Richard
@Dodicat

Here's another multiplier following standard principles....
It's about the same speed as the averager...100 times slower.. Using Dodicats Plus() function slows it down a bit..

I'm working on an ASCII multiplier , it should be the fastest yet..

Code: Select all


Declare function mul_loop_7( num1 as string , num2 as string ) as string

Declare function convert_to_pointers( n as string ) as string

Declare Function plus(_num1 As String,_num2 As String) As String
Declare Function minus(NUM1 As String,NUM2 As String) As String

screen 19

dim as double time1 , time2 , time3 , time4

dim as ulongint total = 0
dim as ulongint loops = 0

dim as longint size1 = 1000
dim as longint size2 = 1000

do
   
    loops+=1
   
    dim as string num1
    for a as longint =  1 to size1 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 string num2
    for a as longint =  1 to size2 step 1
        num2+=str(int(rnd*10))
    next
    if left(num2,1) = "0" then mid(num2,1,1) = str(int(rnd*9)+1)
   
    time1 = timer
       
        dim as string n1 = num1
        dim as string n2 = num2
       
        if len(n1) > len(n2) then n2 = string( len(n1)-len(n2),"0") + n2
        if len(n2) > len(n1) then n1 = string( len(n2)-len(n1),"0") + n1
       
        dim as ubyte size = 9
       
        dim as string str1
        dim as longint dec1
        do
            str1 = str(len(n1) / size)
            dec1 = instr(1,str1,".")
            if dec1<>0 then
                n1="0"+n1
                n2="0"+n2
            end if
        loop until dec1=0
       
        n1 = convert_to_pointers( n1 )
        n2 = convert_to_pointers( n2 )
       
        dim as string my_answer = ""
        dim as string zeros = string( size , "0" )
        dim as ulongint ptr ulp1 = cptr( ulongint ptr , strptr( n1) )
        dim as ulongint ptr ulp2 = cptr( ulongint ptr , strptr( n2) )
        dim as ulongint v1
        dim as ulongint v2
        dim as ulongint carry
        dim as string value
        for a as longint = 1 to len(n1) step 8
            v1 = *ulp1
            value=""
            ulp2 = cptr( ulongint ptr , strptr( n2) )
            dim as string ans
            carry = 0
            for b as longint = 1 to len(n2) step 8
                v2 = v1 * *ulp2
                value = plus( value + zeros , str(v2) )
                ulp2+= 1
            next
            my_answer = plus( my_answer +zeros , value )
            ulp1+= 1
        next
       
     time2 = timer
       
        time3 = timer
            dim as string real_answer = mul_loop_7( num1 , num2 )
        time4 = timer
        dim as string difference = minus( real_answer , my_answer )
       
        if difference = "0" then total+= 1
       
        print
        print "n1          = " ; num1
        print "n2          = "  ; num2
        print "real answer = " ; real_answer
        print "mul answer  = " ; my_answer
        print
        print "DIFF = " ; difference
        print
        print "time = " ; time2-time1
        print "time = " ; time4-time3
       
        if difference <> "0" then print "!!~~ERROR~~!!" : sleep
       
        print
        print "correct = " ; total ; " out of " ; loops
       
        if inkey = " " then sleep
       
loop until inkey = chr(27)

sleep
end
'==================================================
'==================================================
function convert_to_pointers( n as string ) as string

    dim as string n1 = n
    dim as string n2
    dim as ulongint ptr ubp
    dim as ulongint val1
    dim as longint len_1
   
    n2 = string( len(n1) * 10 , chr(0) )
    ubp = cptr( ulongint ptr , strptr( n2 ) )
    len_1 = 0
    for a as longint = 0 to len(n1)-1 step 9
        val1  =  (n1[a+00]-48)*100000000ull
        val1+=  (n1[a+01]-48)*10000000ull
        val1+=  (n1[a+02]-48)*1000000ull
        val1+=  (n1[a+03]-48)*100000ull
        val1+=  (n1[a+04]-48)*10000ull
        val1+=  (n1[a+05]-48)*1000ull
        val1+=  (n1[a+06]-48)*100ull
        val1+=  (n1[a+07]-48)*10ull
        val1+=  (n1[a+08]-48)*1ull
        *ubp = val1
        ubp+=1
        len_1+= 8
    next
    n2 = left( n2 , len_1 )
    return n2
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 mul_loop_7( num1 as string , num2 as string ) as string
   
    dim as string number1 = num1
    dim as string number2 = num2
   
    'make numbers equal multiple of 7 bytes
    dim as string str1
    dim as longint dec1
    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 = cptr(ulongint ptr,strptr(n1))
    dim as longint valu1
    dim as longint len_1 = 0
    for a as longint = 0 to len(number1)-1 step 7
        valu1  = (number1[a     ]-48)*1e6
        valu1+= (number1[a+1]-48)*1e5
        valu1+= (number1[a+2]-48)*1e4
        valu1+= (number1[a+3]-48)*1e3
        valu1+= (number1[a+4]-48)*1e2
        valu1+= (number1[a+5]-48)*1e1
        valu1+= (number1[a+6]-48)'*1
        *ulp1 = valu1
        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 = cptr(ulongint ptr,strptr(n2))
    dim as longint valu2
    dim as longint len_2 = 0
    for a as longint = 0 to len(number2)-1 step 7
        valu2 =  (number2[a     ]-48)*1e6
        valu2+= (number2[a+1]-48)*1e5
        valu2+= (number2[a+2]-48)*1e4
        valu2+= (number2[a+3]-48)*1e3
        valu2+= (number2[a+4]-48)*1e2
        valu2+= (number2[a+5]-48)*1e1
        valu2+= (number2[a+6]-48)'*1
        *ulp2 = valu2
        ulp2+=1
        len_2+=8
    next
    number2 = left(n2,len_2)
    n2=""
   
    'create accumulator
    dim as string answer = string( len(number1) + len(number2) , chr(0) )
    dim as ulongint outblocks = ( len(answer) \ 8 )
    dim as ulongint ptr outplace = cptr(ulongint ptr , strptr(answer)) + (outblocks - 1 )
    dim as ulongint stops = ( (len(number1)\8) + (len(number2)\8) )
    dim as ulongint value = 0
    dim as longint hold = -1
    dim as longint locat = 0
    dim as longint vals = 0
    dim as ulongint high1 = ( len(number1)  \ 8 ) - 1
    dim as ulongint high2 = ( len(number2)  \ 8 ) - 1
    dim as longint ptr num1_ptr = cptr( ulongint ptr , strptr(number1) ) + high1
    dim as longint ptr num2_ptr = cptr( ulongint ptr , strptr(number2) ) + high2
    do
        hold+=1
        vals = hold
        locat = 0
        if vals > high2 then vals = high2 : locat = (hold - high2)
        num1_ptr = cptr( ulongint ptr , strptr(number1) ) + high1 - locat
        num2_ptr = cptr( ulongint ptr , strptr(number2) ) + high2 - vals
        do
            value+= *( num1_ptr ) * *( num2_ptr )
            num1_ptr-=1
            num2_ptr+=1
            if num1_ptr = cptr( ulongint ptr , strptr(number1) ) - 1 then goto done
            if num2_ptr > cptr( ulongint ptr , strptr(number2) ) + high2  then goto done
        loop
        Done:
        *outplace = value mod 1e7
         outplace-= 1
         value = value \ 1e7
    loop until hold = stops-2
   
     *outplace = value mod 1e7
       
    'convert answer back to ascii
   dim as string outtext=""
   outplace = cptr( ulongint ptr , strptr(answer) )
   for a as ulongint = 1 to outblocks step 1
       value = *outplace
       outplace+=1
       outtext+= right("0000000" + str(value),7)
    next   
   
   outtext = ltrim(outtext,"0")
   
   return outtext
   
end function
'===============================================================================
'===============================================================================

dodicat
Posts: 6487
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Dec 14, 2018 0:41

Thanks Albert.
You already have the million mult much less than one minute (The forum fastest).
Are you experimenting with different methods, or are you trying to beat your record?

I notice Richard's comments have a maritime flavour these days, he must have been out in his boat.
albert
Posts: 5676
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Dec 14, 2018 2:18

@Dodicat

I'm trying to beat myself and also trying to beat GMP.
I've got a 500 page notebook full of algorithms I've tried..

I work on paper first , and then put it to code if it works out on paper.






.
Richard
Posts: 3013
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » Dec 14, 2018 4:13

dodicat wrote:You already have the million mult much less than one minute (The forum fastest).

Given two strings, each of one million random ascii digits, 0 to 9 without signs or decimal points, I think it would be hard to multiply them to get the two million character product string in less than a minute.

Does that minute included the time needed to change between ascii and an internal format?

Where is that “forum fastest” code?
dodicat
Posts: 6487
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Dec 14, 2018 10:23

Albert's tester.

Code: Select all


function mul_loop_7( num1 as string , num2 as string ) as string
   
    dim as string number1 = num1
    dim as string number2 = num2
   
    'make numbers equal multiple of 7 bytes
    dim as string str1
    dim as longint dec1
    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 = cptr(ulongint ptr,strptr(n1))
    dim as longint valu1
    dim as longint len_1 = 0
    for a as longint = 0 to len(number1)-1 step 7
        valu1  = (number1[a     ]-48)*1e6
        valu1+= (number1[a+1]-48)*1e5
        valu1+= (number1[a+2]-48)*1e4
        valu1+= (number1[a+3]-48)*1e3
        valu1+= (number1[a+4]-48)*1e2
        valu1+= (number1[a+5]-48)*1e1
        valu1+= (number1[a+6]-48)'*1
        *ulp1 = valu1
        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 = cptr(ulongint ptr,strptr(n2))
    dim as longint valu2
    dim as longint len_2 = 0
    for a as longint = 0 to len(number2)-1 step 7
        valu2 =  (number2[a     ]-48)*1e6
        valu2+= (number2[a+1]-48)*1e5
        valu2+= (number2[a+2]-48)*1e4
        valu2+= (number2[a+3]-48)*1e3
        valu2+= (number2[a+4]-48)*1e2
        valu2+= (number2[a+5]-48)*1e1
        valu2+= (number2[a+6]-48)'*1
        *ulp2 = valu2
        ulp2+=1
        len_2+=8
    next
    number2 = left(n2,len_2)
    n2=""
   
    'create accumulator
    dim as string answer = string( len(number1) + len(number2) , chr(0) )
    dim as ulongint outblocks = ( len(answer) \ 8 )
    dim as ulongint ptr outplace = cptr(ulongint ptr , strptr(answer)) + (outblocks - 1 )
    dim as ulongint stops = ( (len(number1)\8) + (len(number2)\8) )
    dim as ulongint value = 0
    dim as longint hold = -1
    dim as longint locat = 0
    dim as longint vals = 0
    dim as ulongint high1 = ( len(number1)  \ 8 ) - 1
    dim as ulongint high2 = ( len(number2)  \ 8 ) - 1
    dim as longint ptr num1_ptr = cptr( ulongint ptr , strptr(number1) ) + high1
    dim as longint ptr num2_ptr = cptr( ulongint ptr , strptr(number2) ) + high2
    do
        hold+=1
        vals = hold
        locat = 0
        if vals > high2 then vals = high2 : locat = (hold - high2)
        num1_ptr = cptr( ulongint ptr , strptr(number1) ) + high1 - locat
        num2_ptr = cptr( ulongint ptr , strptr(number2) ) + high2 - vals
        do
            value+= *( num1_ptr ) * *( num2_ptr )
            num1_ptr-=1
            num2_ptr+=1
            if num1_ptr = cptr( ulongint ptr , strptr(number1) ) - 1 then goto done
            if num2_ptr > cptr( ulongint ptr , strptr(number2) ) + high2  then goto done
        loop
        Done:
        *outplace = value mod 1e7
         outplace-= 1
         value = value \ 1e7
    loop until hold = stops-2
   
     *outplace = value mod 1e7
       
    'convert answer back to ascii
   dim as string outtext=""
   outplace = cptr( ulongint ptr , strptr(answer) )
   for a as ulongint = 1 to outblocks step 1
       value = *outplace
       outplace+=1
       outtext+= right("0000000" + str(value),7)
    next   
   
   outtext = ltrim(outtext,"0")
   
   return outtext
   
end function

#define range(f,l) Int(Rnd*((l+1)-(f))+(f))
dim as string num1,num2
num1=string(1000000,0)
num2=string(1000000,0)

#macro makeamillion(n)
n[0]=range(49,57)
for z as long=1 to len(n)-1
    n[z]=range(48,57)
next
#endmacro
randomize
makeamillion(num1)
makeamillion(num2)
print len(num1)
print len(num2)

print left(num1,50)+"..."
print left(num2,50)+"..."

dim as string ans

dim as double t=timer
ans=mul_loop_7(num1,num2)
print "Time ";timer-t

 print left(ans,50)+"..."
 print len(ans)
sleep


 


my result

Code: Select all

 1000000
 1000000
10813783728258031776318007452171877482187153320686...
59099918362176285341594674246798385505605846238534...
Time  22.27171389014256
63909373552627998200966298253518511658709704447425...
 1999999
 
albert
Posts: 5676
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Dec 15, 2018 0:12

@Richard
@Dodicat

if you make a number by pointers , * ulongint pointer = 1e18

can you then do a mul stepping by individual bytes... ( val1 = ( * byte pointer) ) * ( val2 = ( * byte pointer) )

I'm trying , but keep getting garbage results

??????
Richard
Posts: 3013
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » Dec 15, 2018 1:00

@dodicat. All things are relative when comparing algorithms. That 22.6 second code takes 360 seconds on my old system, so you are getting a combined total of 16 times speed advantage from your CPU, compiler, optimiser and runtime priority.
How are you doing the compile?
I suspect you are emitting C code from FB, then compiling that for a 64 bit system, with code optimisation turned on.

Return to “General”

Who is online

Users browsing this forum: No registered users and 1 guest