## Squares

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

### Re: Squares

@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 stringDeclare Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As StringDECLARE Function minus(NUM1 As String,NUM2 As String) As StringDeclare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As StringDeclare Function half(fl As String) As Stringdeclare function convert_to_pointers( n as string ) as stringdeclare function make_equal( n as string) as stringdeclare function less_great ( n1 as string , n2 as string) as stringscreen 19dim as double time1 , time2dim as longint size1 = 100dim as longint size2 = 100   dim as longint total = 0dim as longint r_correct = 0do        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)sleepend'================================================== '================================================== 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 charend 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 n2end 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 n1end 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 zDim 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) Thenpart1=Mid\$(s,1,position-1)part2=Mid\$(s,position)s=part1+char+part2End if#endmacroinsert(answer,".",decpos)  answer=thepoint+zeros+answerIf 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 DIVISIONDim As integer lennint,lenddec,lend,lenn,difflensplit(number,".",var1,var2)lennint=Len(var1)split(divisor,".",var1,var2)lenddec=Len(var2)If Instr(number,".") Then     Removepoint(number)    number=var1+var2    End ifIf Instr(divisor,".") Then     Removepoint(divisor)    divisor=var1+var2    End ifDim As integer numzerosnumzeros=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-lennDim decpos As integer=lenddec+lennint-lend+2-numzeros 'THE POSITION INDICATORDim _sgn As Byte=-Sgn(decpos)If _sgn=0 Then _sgn=1Dim As String thepoint=String(_sgn,".") 'DECIMAL AT START (IF)Dim As String zeros=String(-decpos+1,"0")'ZEROS AT START (IF) e.g. .0009if dpflag<>"mod" thenIf Len(zeros) =0 Then dpflag="s"end ifDim As integer runlengthIf 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 IfElsedecimal_places=decimal_places+decposrunlength=decimal_placesanswer=String(Len(zeros)+runlength+10,"0")End if'___________DECIMAL POSITION DETERMINED  _____________'SET UP THE VARIABLES AND START UP CONDITIONSnumber=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 'notIf Lens>lenf Thentemp= "done"Exit DoEnd ifIf divisor>topstring Then temp= "done"Exit DoEnd ifEnd 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+answerEnd 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 ansEnd 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=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=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 outtextend function'==============================================================================='===============================================================================`
albert
Posts: 5927
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@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 stringDeclare Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As StringDECLARE Function minus(NUM1 As String,NUM2 As String) As StringDeclare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As StringDeclare Function half(fl As String) As Stringdeclare function convert_to_pointers( n as string ) as stringdeclare function make_equal( n as string) as stringdeclare function less_great ( n1 as string , n2 as string) as stringscreen 19dim as double time1 , time2 , time3 , time4dim as longint size1 = 10000dim as longint size2 = 10000dim as longint total = 0dim as longint r_correct = 0do         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)sleepend'================================================== '================================================== 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 charend 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 n2end 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 n1end 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 zDim 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) Thenpart1=Mid\$(s,1,position-1)part2=Mid\$(s,position)s=part1+char+part2End if#endmacroinsert(answer,".",decpos)  answer=thepoint+zeros+answerIf 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 DIVISIONDim As integer lennint,lenddec,lend,lenn,difflensplit(number,".",var1,var2)lennint=Len(var1)split(divisor,".",var1,var2)lenddec=Len(var2)If Instr(number,".") Then     Removepoint(number)    number=var1+var2    End ifIf Instr(divisor,".") Then     Removepoint(divisor)    divisor=var1+var2    End ifDim As integer numzerosnumzeros=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-lennDim decpos As integer=lenddec+lennint-lend+2-numzeros 'THE POSITION INDICATORDim _sgn As Byte=-Sgn(decpos)If _sgn=0 Then _sgn=1Dim As String thepoint=String(_sgn,".") 'DECIMAL AT START (IF)Dim As String zeros=String(-decpos+1,"0")'ZEROS AT START (IF) e.g. .0009if dpflag<>"mod" thenIf Len(zeros) =0 Then dpflag="s"end ifDim As integer runlengthIf 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 IfElsedecimal_places=decimal_places+decposrunlength=decimal_placesanswer=String(Len(zeros)+runlength+10,"0")End if'___________DECIMAL POSITION DETERMINED  _____________'SET UP THE VARIABLES AND START UP CONDITIONSnumber=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 'notIf Lens>lenf Thentemp= "done"Exit DoEnd ifIf divisor>topstring Then temp= "done"Exit DoEnd ifEnd 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+answerEnd 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 ansEnd 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=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=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: 5927
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@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 stringDeclare Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As StringDECLARE Function minus(NUM1 As String,NUM2 As String) As StringDeclare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As StringDeclare Function half(fl As String) As Stringdeclare function convert_to_pointers( n as string ) as stringdeclare function make_equal( n as string) as stringdeclare function less_great ( n1 as string , n2 as string) as stringscreen 19dim as double time1 , time2 , time3 , time4dim as longint size1 = 10000dim as longint size2 = 10000dim as longint total = 0dim as longint r_correct = 0do         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)sleepend'================================================== '================================================== 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 charend 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 n2end 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 n1end 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 zDim 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) Thenpart1=Mid\$(s,1,position-1)part2=Mid\$(s,position)s=part1+char+part2End if#endmacroinsert(answer,".",decpos)  answer=thepoint+zeros+answerIf 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 DIVISIONDim As integer lennint,lenddec,lend,lenn,difflensplit(number,".",var1,var2)lennint=Len(var1)split(divisor,".",var1,var2)lenddec=Len(var2)If Instr(number,".") Then     Removepoint(number)    number=var1+var2    End ifIf Instr(divisor,".") Then     Removepoint(divisor)    divisor=var1+var2    End ifDim As integer numzerosnumzeros=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-lennDim decpos As integer=lenddec+lennint-lend+2-numzeros 'THE POSITION INDICATORDim _sgn As Byte=-Sgn(decpos)If _sgn=0 Then _sgn=1Dim As String thepoint=String(_sgn,".") 'DECIMAL AT START (IF)Dim As String zeros=String(-decpos+1,"0")'ZEROS AT START (IF) e.g. .0009if dpflag<>"mod" thenIf Len(zeros) =0 Then dpflag="s"end ifDim As integer runlengthIf 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 IfElsedecimal_places=decimal_places+decposrunlength=decimal_placesanswer=String(Len(zeros)+runlength+10,"0")End if'___________DECIMAL POSITION DETERMINED  _____________'SET UP THE VARIABLES AND START UP CONDITIONSnumber=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 'notIf Lens>lenf Thentemp= "done"Exit DoEnd ifIf divisor>topstring Then temp= "done"Exit DoEnd ifEnd 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+answerEnd 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 ansEnd 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=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=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: 3047
Joined: Jan 15, 2007 20:44
Location: Australia

### Re: Squares

@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: 339
Joined: Jun 02, 2007 12:35
Location: Sydney, Australia

### Re: Squares

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

### Re: Squares

@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 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 stringDeclare Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As StringDECLARE Function minus(NUM1 As String,NUM2 As String) As StringDeclare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As StringDeclare Function half(fl As String) As Stringdeclare function convert_to_pointers( n as string ) as stringdeclare function less_great ( n1 as string , n2 as string) as stringscreen 19dim as double time1 , time2 , time3 , time4dim as longint size1 = 1000dim as longint size2 = 1000dim as longint total = 0dim as longint r_correct = 0do       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)sleepsleepend'=================================================='==================================================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         nextend 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 n2end 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 zDim 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) Thenpart1=Mid\$(s,1,position-1)part2=Mid\$(s,position)s=part1+char+part2End if#endmacroinsert(answer,".",decpos)  answer=thepoint+zeros+answerIf 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 DIVISIONDim As integer lennint,lenddec,lend,lenn,difflensplit(number,".",var1,var2)lennint=Len(var1)split(divisor,".",var1,var2)lenddec=Len(var2)If Instr(number,".") Then    Removepoint(number)    number=var1+var2    End ifIf Instr(divisor,".") Then    Removepoint(divisor)    divisor=var1+var2    End ifDim As integer numzerosnumzeros=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-lennDim decpos As integer=lenddec+lennint-lend+2-numzeros 'THE POSITION INDICATORDim _sgn As Byte=-Sgn(decpos)If _sgn=0 Then _sgn=1Dim As String thepoint=String(_sgn,".") 'DECIMAL AT START (IF)Dim As String zeros=String(-decpos+1,"0")'ZEROS AT START (IF) e.g. .0009if dpflag<>"mod" thenIf Len(zeros) =0 Then dpflag="s"end ifDim As integer runlengthIf 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 IfElsedecimal_places=decimal_places+decposrunlength=decimal_placesanswer=String(Len(zeros)+runlength+10,"0")End if'___________DECIMAL POSITION DETERMINED  _____________'SET UP THE VARIABLES AND START UP CONDITIONSnumber=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 'notIf Lens>lenf Thentemp= "done"Exit DoEnd ifIf divisor>topstring Thentemp= "done"Exit DoEnd ifEnd 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+answerEnd 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 ansEnd 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=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=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: 6756
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Squares

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

### Re: Squares

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

### Re: Squares

@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 stringDeclare function convert_to_pointers( n as string ) as stringDeclare Function plus(_num1 As String,_num2 As String) As StringDeclare Function minus(NUM1 As String,NUM2 As String) As Stringscreen 19dim as double time1 , time2 , time3 , time4dim as ulongint total = 0dim as ulongint loops = 0 dim as longint size1 = 1000dim as longint size2 = 1000do        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)sleepend'=================================================='==================================================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 n2end 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=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=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: 6756
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Squares

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

### Re: Squares

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

### Re: Squares

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: 6756
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Squares

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,num2num1=string(1000000,0)num2=string(1000000,0)#macro makeamillion(n)n=range(49,57)for z as long=1 to len(n)-1    n[z]=range(48,57)next#endmacrorandomizemakeamillion(num1)makeamillion(num2)print len(num1)print len(num2)print left(num1,50)+"..."print left(num2,50)+"..."dim as string ansdim as double t=timerans=mul_loop_7(num1,num2)print "Time ";timer-t print left(ans,50)+"..." print len(ans)sleep  `

my result

Code: Select all

` 1000000 100000010813783728258031776318007452171877482187153320686...59099918362176285341594674246798385505605846238534...Time  22.2717138901425663909373552627998200966298253518511658709704447425... 1999999 `
albert
Posts: 5927
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

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

### Re: Squares

@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.