Squares

General FreeBASIC programming questions.
Locked
Richard
Posts: 3096
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Post by Richard »

Albert wrote:You'd need to get a "postal service" map of the city , so the program knows, where all the addresses are.
No Albert, you need to do it.
Did you not look as the wiki link I posted. It shows animations of the solution process.
I am not going to take on writing a TSP route approximation program for use in the real world.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Post by dodicat »

How are you progressing with the boat Richard?
Richard
Posts: 3096
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Post by Richard »

dodicat wrote:How are you progressing with the boat Richard?
The boat is happily sitting on her semi-trailer while I collect and plan things. I'm rearranging things here ready for some modifications to the back part of the keel and removal of the vulnerable early-design rudder-skeg. I was very lucky to find a Hundested VP prop, shaft and controls, to go with the little used Perkins 4.236 I have been saving.
I've also been distracted in a big way by helping with the startup of a wireless based ISP on the other side of this continent. It delivers services to remote rural areas and communities that the existing services do not reach.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Post by dodicat »

We had a Perkins four cylinder on our 32 feet ex navy pinnace , which we made into a little trawler.
We initially had gearbox trouble (Self Change box), but fixed it.
I couldn't believe the price of hydraulic oil recommended for use in it.
Until an old fisherman said he used ordinary engine oil, which we then did, and it ran for years.
The one little niggle with the Perkins set up was the silly little Jabsco salt water pump and impeller.
We always carried spare impellers, they were very prone to disintegration suddenly.
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@Dodicat

Where do you download the German FreeBASIC 1.05 64bit??

I forgot the link to , and it contains all the libs that are missing in the normal FB.
lizard
Posts: 440
Joined: Oct 17, 2017 11:35
Location: Germany

Re: Squares

Post by lizard »

St_W
Posts: 1619
Joined: Feb 11, 2009 14:24
Location: Austria
Contact:

Re: Squares

Post by St_W »

That is just a mirror of the official FB package(s) available from sourceforge:
https://sourceforge.net/projects/fbc/fi ... 20Windows/
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@Dodicat
@Richard

I can't seem to get my adder working right...
its printing out the correct values.
But i cn't seem to figure out how to add the results...

Code: Select all


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

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

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

dim as double time1 , time2 , time3 , time4

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

    time1=timer
        
        dim as ulongint muls( 1 to (len(num1) * 2) )
        dim as ulongint val1 = 0
        dim as ulongint val2 = 0
        dim as ulongint value = 0
        dim as ulongint place = 1
        for a as longint = len(num1) to 1 step -1
            val1 = val(mid(num1,a,1))
            for b as longint = len(num1) to 1 step -1
                val2 = val(mid(num1,b,1))
                value = val1 * val2
                muls(place) = value
                print "values = " ; val1 , val2 , place , muls(place)
                place+=1
            next
        next
                
        
        ' Hello Dodicat !!
        ' I can't seem to get the adder working right
        ' Can you give me a hand...
        dim as string ans = ""
        for a as longint = ubound(muls) to 1 step -1
            ans = plus( ans +"00" ,  str(muls(a)) )
        next
        
        dim as string answer = (ans)
        
        
    time2=timer
    
    time3 = timer
        dim as string real_answer = multiplier_7( num1,num1)
        real_answer = left(real_answer,len(real_answer)-1)
    time4 = timer
    
    dim as string diff = minus( real_answer , answer )
    
    print
    print num1
    print
    print real_answer
    print
    print answer
    print
    print "diff = " ; diff
    'print "loops = " ; loops
    'print "loops per digit = " ; loops / len(num1) 
    print
    print "Adder Time         = " ; time2 - time1
    print "Multiplier/-7 time = " ; time4 - time3
    
    sleep
    
loop until inkey = chr(27)

sleep
end
'===============================================================================
'===============================================================================
'Dodicats plus & Minus functions
'===============================================================================
'===============================================================================
    Function plus(_num1 As String,_num2 As String) As String
        Dim  ADDQmod(0 To 19) As Ubyte
        Dim  ADDbool(0 To 19) As Ubyte
        For z As Integer=0 To 19
            ADDQmod(z)=(z Mod 10+48)
            ADDbool(z)=(-(10<=z))
        Next z
        Var _flag=0,n_=0
        Dim As Ubyte addup=Any,addcarry=Any
        #macro finish()
        answer=Ltrim(answer,"0")
        If _flag=1 Then Swap _num2,_num1
        Return answer
        #endmacro
        If Len(_num2)>Len(_num1) Then
            Swap _num2,_num1
            _flag=1
        End If
        Var diff=Len(_num1)-Len(_num2)
        Var answer="0"+_num1
        addcarry=0
        For n_=Len(_num1)-1 To diff Step -1
            addup=_num2[n_-diff]+_num1[n_]-96
            answer[n_+1]=ADDQmod(addup+addcarry)
            addcarry=ADDbool(addup+addcarry)
        Next n_
        If addcarry=0 Then
            finish()
        End If
        If n_=-1 Then
            answer[0]=addcarry+48
            finish()
            Endif
            For n_=n_ To 0 Step -1
                addup=_num1[n_]-48
                answer[n_+1]=ADDQmod(addup+addcarry)
                addcarry=ADDbool(addup+addcarry)
                If addcarry=0 Then Exit For
            Next n_
            answer[0]=addcarry+48
            finish()
        End Function
'===============================================================================
'===============================================================================
Function minus(NUM1 As String,NUM2 As String) As String
     'Dim As String copyfirstnum=mul_num_1,copysecondnum=mul_num_2
    Dim As Byte swapflag           
    Dim As Long lenf,lens
    Dim sign As String * 1
    'Dim As String part1,part2
    Dim bigger As Byte
     'set up tables
    Dim As Ubyte Qmod(0 To 19)
    Dim bool(0 To 19) As Ubyte

    For z As Integer=0 To 19
        Qmod(z)=cubyte(z Mod 10+48)
        bool(z)=cubyte(-(10>z))
    Next z
    lenf=Len(NUM1)
    lens=Len(NUM2)
    #macro compare(numbers)
        If Lens>lenf Then bigger= -1:Goto fin
        If Lens<lenf Then bigger =0:Goto fin
        If NUM2>NUM1 Then
            bigger=-1
        Else
            bigger= 0
        End If
        fin:
    #endmacro

    compare(numbers)
    If bigger Then
        sign="-"
        Swap NUM2,NUM1
        Swap lens,lenf
        swapflag=1
    Endif
    'lenf=Len(NUM1)
    'lens=Len(NUM2)
    Dim diff As Long=lenf-lens-Sgn(lenf-lens)
    Dim As String one,two,three
    three=NUM1
    two=String(lenf-lens,"0")+NUM2
    one=NUM1
    Dim As Long n2
    Dim As Ubyte takeaway,subtractcarry
    Dim As Ubyte ten=10
    'Dim z As Long
    subtractcarry=0
    Do
         For n2=lenf-1 To diff Step -1
           takeaway= one[n2]-two[n2]+ten-subtractcarry
           three[n2]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
        Next n2
        If subtractcarry=0 Then Exit Do
        If n2=-1 Then Exit Do
        For n2=n2 To 0 Step -1
            takeaway= one[n2]-two[n2]+ten-subtractcarry
            three[n2]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
            Next n2
        Exit Do
    Loop
   
    three=Ltrim(three,"0")
    If three="" Then Return "0"
    If swapflag=1 Then Swap NUM1,NUM2
   
    Return sign+three
   
End Function
'===============================================================================
'===============================================================================
function multiplier_7(byref num1 as string, byref num2 as string) as string
   
    dim as string number1,number2
    dim as string answer,outtext
   
    dim as string int1,frac1,int2,frac2
    dim as ulongint dec,dec1,len1,len2
    dim as string str1
    dim as string sign1,sign2,outsign
   
    number1 = num1
    number2 = num2
   
    sign1 = left(number1,1)
    if sign1 = "+" or sign1 = "-" then number1 = mid(number1,2) else sign1 = ""
   
    sign2 = left(number2,1)
    if sign2 = "+" or sign2 = "-" then number2 = mid(number2,2) else sign2 = ""
   
    if (sign1 = sign2) then outsign = ""
    if (sign1 <> sign2) then outsign = "-"
   
    dec = instr(1,number1,".")
    if dec > 0 then
        int1 = left(number1,dec-1)
        frac1 = mid(number1,dec+1)
    else
        int1 = number1
        frac1 = ""
    end if
   
    dec = instr(1,number2,".")
    if dec > 0 then
        int2 = left(number2,dec-1)
        frac2 = mid(number2,dec+1)
    else
        int2 = number2
        frac2 = ""
    end if

    dec = len(frac1)+len(frac2)
    number1 = int1+frac1
    number2 = int2+frac2

    'swap numbers so that bigger number is number1 and smaller is number2
    if len(number2) > len(number1) then swap number1,number2
    if len(number1) = len(number2) then
        if val(left(number2,1)) > val(left(number1,1)) then swap number1,number2
    end if

    'make numbers equal multiple of 7 bytes
    do
        str1 = str(len(number1)/7)
        dec1 = instr(1,str1,".")
        if dec1 <> 0 then number1 = "0" + number1
    loop until dec1 = 0
    do
        str1 = str(len(number2)/7)
        dec1 = instr(1,str1,".")
        if dec1 <> 0 then number2 = "0" + number2
    loop until dec1 = 0
   
    'convert the numeric strings to use pointers
    'convert number1
    dim as string n1 = string(len(number1)*8,chr(0))
    dim as ulongint ptr ulp1
    ulp1 = cptr(ulongint ptr,strptr(n1))
    dim as longint val1
    dim as longint len_1 = 0
    dim as uinteger a
    for a = 0 to len(number1)-1 step 7
        val1 = (number1[a+0]-48)*1000000ull
        val1+= (number1[a+1]-48)*100000ull
        val1+= (number1[a+2]-48)*10000ull
        val1+= (number1[a+3]-48)*1000ull
        val1+= (number1[a+4]-48)*100ull
        val1+= (number1[a+5]-48)*10ull
        val1+= (number1[a+6]-48)*1ull
        *ulp1 = val1
        ulp1+=1
        len_1+=8
    next
    number1 = left(n1,len_1)
    n1=""
   
    'convert the numeric strings to use pointers
    'convert number2
    dim as string n2 = string(len(number2)*8,chr(0))
    dim as ulongint ptr ulp2
    ulp2 = cptr(ulongint ptr,strptr(n2))
    dim as longint val2
    dim as longint len_2 = 0
    for a = 0 to len(number2)-1 step 7
        val2 = (number2[a+0]-48)*1000000ull
        val2+= (number2[a+1]-48)*100000ull
        val2+= (number2[a+2]-48)*10000ull
        val2+= (number2[a+3]-48)*1000ull
        val2+= (number2[a+4]-48)*100ull
        val2+= (number2[a+5]-48)*10ull
        val2+= (number2[a+6]-48)*1ull
        *ulp2 = val2
        ulp2+=1
        len_2+=8
    next
    number2 = left(n2,len_2)
    n2=""
   
    'create accumulator
    answer = string( len(number1) + len(number2) + 8 , chr(0) )
    'dimension vars for the mul
    dim as longint ptr start1,stop1,start2,stop2 'use longint because the pointers go negative
    dim as longint ptr chk_1 , chk_2
    dim as longint ptr inc1,inc2
    dim as longint ptr outplace
    dim as ulongint carry
    dim as ulongint total
    dim as ulongint blocknumber1 = len(number1)/8
    dim as ulongint blocknumber2 = len(number2)/8
    dim as ulongint outblocks = len(answer)/8
   
    'set initial accumulator place
    outplace = cptr(longint ptr , strptr(answer)) + (outblocks - 1)
    'set initial pointers into number1
    start1 = cptr(longint ptr , strptr(number1))+(blocknumber1-1)
    stop1 =  cptr(longint ptr , strptr(number1))+(blocknumber1-1)
    'set initial pointers into number2
    start2 = cptr(longint ptr , strptr(number2))+(blocknumber2-1)
    stop2 =  cptr(longint ptr , strptr(number2))+(blocknumber2-1)
    'set comparison to beg of numbers
    chk_1 = cptr( longint ptr , strptr(number1))
    chk_2 = cptr( longint ptr , strptr(number2))
   
    'zero the carry
    carry = 0
   
    'begin looping thru strings multiplying
    do
        'set total to zero
        total = 0
        'we are going to be incrementing thru number2 while decrementing thru number1
        'working in opposite directions from start1 to stop1 and start2 to stop2
        'inc1 works from right to left in the top number1 string
        'inc2 works from start2 to stop 2, in the bottom number2 string, decrementing each loop.
        inc1 = start1
        inc2 = start2
        do
            total += *inc1 * *inc2
            inc1-= 1
            inc2+= 1
        loop until inc2 = stop2+1
   
        total = total + carry
        carry = total \ 1e7
        *outplace = total mod 1e7
        '*outplace = imod(total , 1e7)
       
        outplace -= 1
       
        'each loop we need to decrement stop1
        'if stop1 goes negative we reset it to zero and decrement stop2
        stop1 -= 1
        if stop1 < chk_1 then
            stop1 += 1
            stop2 -=1
            if stop2 < chk_2 then stop2+= 1
        end if
        'each loop we decrement start2 to the left
        start2 -= 1
        'if start2 goes negative we reset it to zero and decrement start1
        'start1 is the rightmost digit of number1 we need to multiply
        if start2 < chk_2 then
            start2 += 1
            start1 -= 1
            if start1 < chk_1 then start1+=1
        end if
   
    loop until outplace = cptr(ulongint ptr,strptr(answer))+1
   
    'put in the carry at the end
    if carry > 0  then *outplace = carry else *outplace = 0
   
    'convert answer back to ascii
    for a as ulongint = 1 to outblocks-1 step 1
        val1 = *outplace
        outplace +=1
        outtext = outtext + right("0000000" + str(val1),7)
    next   

    'put in the decimal point
    outtext = left(outtext,len(outtext)-dec) + "." +  mid(outtext,(len(outtext)-dec)+1)
    'trim leading zeros
    outtext = trim(outtext,"0") 'if multiplying by 1, we have a zero in front.
    outtext = outsign + outtext

    return outtext

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

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

Re: Squares

Post by dodicat »

Working on this Albert.
Yet to figure out your method.
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@Dodicat

I got it working with 3's ,
Can you help develop the looping?

Code: Select all


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

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

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

dim as double time1 , time2 , time3 , time4

screen 19

do
    
    dim as string num1 = ""
    for a as longint = 1 to 3
        num1+=str(int(rnd*10))
    next
    
    if left(num1,1) = "0" then mid(num1,1,1) = str(int(rnd*9)+1)
    
    time1=timer
    
        dim as ulongint muls( 1 to len(num1) )
            for a as longint = 1 to len(num1) step 1
                muls(a) = val(mid(num1,a,1))  ^ 2
            next
        dim as ulongint val1 = 0
        dim as ulongint val2 = 0
        dim as ulongint value = 0
                val1 = val(mid(num1,1,1))
                val2 = val(mid(num1,2,1))
                value = val1 * val2
                muls(2)+= ((value mod 10))* 10 * 2
                muls(1)+= (value \ 10) * 2
                
                '================================
                val1 = val(mid(num1,1,1))
                val2 = val(mid(num1,3,1))
                value = val1 * val2 * 10
                val1 = val(mid(num1,2,1))
                val2 = val(mid(num1,3,1))
                value+= val1 * val2
                muls(3)+= ((value mod 10))* 10 * 2
                muls(2)+= (value \ 10) * 2
                
                
                print "values = " ; val1 , val2
                print "muls 1 = " ; muls(1)
                print "muls 2 = "; muls(2)
                print "muls 3 = "; muls(3)
                'print "muls 4 = "; muls(4)
                'print "muls 5 = "; muls(5)
                
        for a as longint = 1 to ubound(muls)
            value = muls(a)
            ans = plus( ans + string(2,"0") , str(value) )
        next
        
        dim as string answer = ans
        
    time2=timer
    
    time3 = timer
        dim as string real_answer = multiplier_7( num1,num1)
        real_answer = left(real_answer,len(real_answer)-1)
    time4 = timer
    
    dim as string diff = minus( real_answer , answer )
    
    print
    print num1
    print
    print real_answer
    print
    print answer
    print
    print "diff = " ; diff
    'print "loops = " ; loops
    'print "loops per digit = " ; loops / len(num1) 
    print
    print "Adder Time         = " ; time2 - time1
    print "Multiplier/-7 time = " ; time4 - time3
    
    sleep
    
loop until inkey = chr(27)

sleep
end
'===============================================================================
'===============================================================================
'Dodicats plus & Minus functions
'===============================================================================
'===============================================================================
    Function plus(_num1 As String,_num2 As String) As String
        Dim  ADDQmod(0 To 19) As Ubyte
        Dim  ADDbool(0 To 19) As Ubyte
        For z As Integer=0 To 19
            ADDQmod(z)=(z Mod 10+48)
            ADDbool(z)=(-(10<=z))
        Next z
        Var _flag=0,n_=0
        Dim As Ubyte addup=Any,addcarry=Any
        #macro finish()
        answer=Ltrim(answer,"0")
        If _flag=1 Then Swap _num2,_num1
        Return answer
        #endmacro
        If Len(_num2)>Len(_num1) Then
            Swap _num2,_num1
            _flag=1
        End If
        Var diff=Len(_num1)-Len(_num2)
        Var answer="0"+_num1
        addcarry=0
        For n_=Len(_num1)-1 To diff Step -1
            addup=_num2[n_-diff]+_num1[n_]-96
            answer[n_+1]=ADDQmod(addup+addcarry)
            addcarry=ADDbool(addup+addcarry)
        Next n_
        If addcarry=0 Then
            finish()
        End If
        If n_=-1 Then
            answer[0]=addcarry+48
            finish()
            Endif
            For n_=n_ To 0 Step -1
                addup=_num1[n_]-48
                answer[n_+1]=ADDQmod(addup+addcarry)
                addcarry=ADDbool(addup+addcarry)
                If addcarry=0 Then Exit For
            Next n_
            answer[0]=addcarry+48
            finish()
        End Function
'===============================================================================
'===============================================================================
Function minus(NUM1 As String,NUM2 As String) As String
     'Dim As String copyfirstnum=mul_num_1,copysecondnum=mul_num_2
    Dim As Byte swapflag           
    Dim As Long lenf,lens
    Dim sign As String * 1
    'Dim As String part1,part2
    Dim bigger As Byte
     'set up tables
    Dim As Ubyte Qmod(0 To 19)
    Dim bool(0 To 19) As Ubyte

    For z As Integer=0 To 19
        Qmod(z)=cubyte(z Mod 10+48)
        bool(z)=cubyte(-(10>z))
    Next z
    lenf=Len(NUM1)
    lens=Len(NUM2)
    #macro compare(numbers)
        If Lens>lenf Then bigger= -1:Goto fin
        If Lens<lenf Then bigger =0:Goto fin
        If NUM2>NUM1 Then
            bigger=-1
        Else
            bigger= 0
        End If
        fin:
    #endmacro

    compare(numbers)
    If bigger Then
        sign="-"
        Swap NUM2,NUM1
        Swap lens,lenf
        swapflag=1
    Endif
    'lenf=Len(NUM1)
    'lens=Len(NUM2)
    Dim diff As Long=lenf-lens-Sgn(lenf-lens)
    Dim As String one,two,three
    three=NUM1
    two=String(lenf-lens,"0")+NUM2
    one=NUM1
    Dim As Long n2
    Dim As Ubyte takeaway,subtractcarry
    Dim As Ubyte ten=10
    'Dim z As Long
    subtractcarry=0
    Do
         For n2=lenf-1 To diff Step -1
           takeaway= one[n2]-two[n2]+ten-subtractcarry
           three[n2]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
        Next n2
        If subtractcarry=0 Then Exit Do
        If n2=-1 Then Exit Do
        For n2=n2 To 0 Step -1
            takeaway= one[n2]-two[n2]+ten-subtractcarry
            three[n2]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
            Next n2
        Exit Do
    Loop
   
    three=Ltrim(three,"0")
    If three="" Then Return "0"
    If swapflag=1 Then Swap NUM1,NUM2
   
    Return sign+three
   
End Function
'===============================================================================
'===============================================================================
function multiplier_7(byref num1 as string, byref num2 as string) as string
   
    dim as string number1,number2
    dim as string answer,outtext
   
    dim as string int1,frac1,int2,frac2
    dim as ulongint dec,dec1,len1,len2
    dim as string str1
    dim as string sign1,sign2,outsign
   
    number1 = num1
    number2 = num2
   
    sign1 = left(number1,1)
    if sign1 = "+" or sign1 = "-" then number1 = mid(number1,2) else sign1 = ""
   
    sign2 = left(number2,1)
    if sign2 = "+" or sign2 = "-" then number2 = mid(number2,2) else sign2 = ""
   
    if (sign1 = sign2) then outsign = ""
    if (sign1 <> sign2) then outsign = "-"
   
    dec = instr(1,number1,".")
    if dec > 0 then
        int1 = left(number1,dec-1)
        frac1 = mid(number1,dec+1)
    else
        int1 = number1
        frac1 = ""
    end if
   
    dec = instr(1,number2,".")
    if dec > 0 then
        int2 = left(number2,dec-1)
        frac2 = mid(number2,dec+1)
    else
        int2 = number2
        frac2 = ""
    end if

    dec = len(frac1)+len(frac2)
    number1 = int1+frac1
    number2 = int2+frac2

    'swap numbers so that bigger number is number1 and smaller is number2
    if len(number2) > len(number1) then swap number1,number2
    if len(number1) = len(number2) then
        if val(left(number2,1)) > val(left(number1,1)) then swap number1,number2
    end if

    'make numbers equal multiple of 7 bytes
    do
        str1 = str(len(number1)/7)
        dec1 = instr(1,str1,".")
        if dec1 <> 0 then number1 = "0" + number1
    loop until dec1 = 0
    do
        str1 = str(len(number2)/7)
        dec1 = instr(1,str1,".")
        if dec1 <> 0 then number2 = "0" + number2
    loop until dec1 = 0
   
    'convert the numeric strings to use pointers
    'convert number1
    dim as string n1 = string(len(number1)*8,chr(0))
    dim as ulongint ptr ulp1
    ulp1 = cptr(ulongint ptr,strptr(n1))
    dim as longint val1
    dim as longint len_1 = 0
    dim as uinteger a
    for a = 0 to len(number1)-1 step 7
        val1 = (number1[a+0]-48)*1000000ull
        val1+= (number1[a+1]-48)*100000ull
        val1+= (number1[a+2]-48)*10000ull
        val1+= (number1[a+3]-48)*1000ull
        val1+= (number1[a+4]-48)*100ull
        val1+= (number1[a+5]-48)*10ull
        val1+= (number1[a+6]-48)*1ull
        *ulp1 = val1
        ulp1+=1
        len_1+=8
    next
    number1 = left(n1,len_1)
    n1=""
   
    'convert the numeric strings to use pointers
    'convert number2
    dim as string n2 = string(len(number2)*8,chr(0))
    dim as ulongint ptr ulp2
    ulp2 = cptr(ulongint ptr,strptr(n2))
    dim as longint val2
    dim as longint len_2 = 0
    for a = 0 to len(number2)-1 step 7
        val2 = (number2[a+0]-48)*1000000ull
        val2+= (number2[a+1]-48)*100000ull
        val2+= (number2[a+2]-48)*10000ull
        val2+= (number2[a+3]-48)*1000ull
        val2+= (number2[a+4]-48)*100ull
        val2+= (number2[a+5]-48)*10ull
        val2+= (number2[a+6]-48)*1ull
        *ulp2 = val2
        ulp2+=1
        len_2+=8
    next
    number2 = left(n2,len_2)
    n2=""
   
    'create accumulator
    answer = string( len(number1) + len(number2) + 8 , chr(0) )
    'dimension vars for the mul
    dim as longint ptr start1,stop1,start2,stop2 'use longint because the pointers go negative
    dim as longint ptr chk_1 , chk_2
    dim as longint ptr inc1,inc2
    dim as longint ptr outplace
    dim as ulongint carry
    dim as ulongint total
    dim as ulongint blocknumber1 = len(number1)/8
    dim as ulongint blocknumber2 = len(number2)/8
    dim as ulongint outblocks = len(answer)/8
   
    'set initial accumulator place
    outplace = cptr(longint ptr , strptr(answer)) + (outblocks - 1)
    'set initial pointers into number1
    start1 = cptr(longint ptr , strptr(number1))+(blocknumber1-1)
    stop1 =  cptr(longint ptr , strptr(number1))+(blocknumber1-1)
    'set initial pointers into number2
    start2 = cptr(longint ptr , strptr(number2))+(blocknumber2-1)
    stop2 =  cptr(longint ptr , strptr(number2))+(blocknumber2-1)
    'set comparison to beg of numbers
    chk_1 = cptr( longint ptr , strptr(number1))
    chk_2 = cptr( longint ptr , strptr(number2))
   
    'zero the carry
    carry = 0
   
    'begin looping thru strings multiplying
    do
        'set total to zero
        total = 0
        'we are going to be incrementing thru number2 while decrementing thru number1
        'working in opposite directions from start1 to stop1 and start2 to stop2
        'inc1 works from right to left in the top number1 string
        'inc2 works from start2 to stop 2, in the bottom number2 string, decrementing each loop.
        inc1 = start1
        inc2 = start2
        do
            total += *inc1 * *inc2
            inc1-= 1
            inc2+= 1
        loop until inc2 = stop2+1
   
        total = total + carry
        carry = total \ 1e7
        *outplace = total mod 1e7
        '*outplace = imod(total , 1e7)
       
        outplace -= 1
       
        'each loop we need to decrement stop1
        'if stop1 goes negative we reset it to zero and decrement stop2
        stop1 -= 1
        if stop1 < chk_1 then
            stop1 += 1
            stop2 -=1
            if stop2 < chk_2 then stop2+= 1
        end if
        'each loop we decrement start2 to the left
        start2 -= 1
        'if start2 goes negative we reset it to zero and decrement start1
        'start1 is the rightmost digit of number1 we need to multiply
        if start2 < chk_2 then
            start2 += 1
            start1 -= 1
            if start1 < chk_1 then start1+=1
        end if
   
    loop until outplace = cptr(ulongint ptr,strptr(answer))+1
   
    'put in the carry at the end
    if carry > 0  then *outplace = carry else *outplace = 0
   
    'convert answer back to ascii
    for a as ulongint = 1 to outblocks-1 step 1
        val1 = *outplace
        outplace +=1
        outtext = outtext + right("0000000" + str(val1),7)
    next   

    'put in the decimal point
    outtext = left(outtext,len(outtext)-dec) + "." +  mid(outtext,(len(outtext)-dec)+1)
    'trim leading zeros
    outtext = trim(outtext,"0") 'if multiplying by 1, we have a zero in front.
    outtext = outsign + outtext

    return outtext

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

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

Re: Squares

Post by albert »

@Dodicat

I got it working up to 18 digits.
Now , to get it stepping by 7's , 8's or 9's

Code: Select all


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

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

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

dim as double time1 , time2 , time3 , time4

screen 19


do
    
    dim as string num1 = ""
    for a as longint = 1 to 18
        num1+=str(int(rnd*10))
    next
    
    if left(num1,1) = "0" then mid(num1,1,1) = str(int(rnd*9)+1)
    
    time1=timer
    
        dim as ulongint muls( 1 to len(num1) )
            for a as longint = 1 to len(num1) step 1
                muls(a) = val(mid(num1,a,1))  ^ 2
            next
        dim as ulongint val1 = 0
        dim as ulongint val2 = 0
        dim as string str_value = ""
        dim as ulongint value= 0
        for place as longint = 2 to len(num1)
            val1 = val(mid(num1,place,1))
            str_value=""
            value = 0
            for b as longint = 1 to place-1
                val2 = val(mid(num1,b,1))
                value+= val1*val2
                value*=10
                'str_value = plus( str_value+"0" , str(val1 * val2) )
            next
            'value = valulng(str_value)
            value\=10
            muls(place    )+= ((value mod 10))* 10 * 2
            muls(place-1)+= (value \ 10) * 2
        next
        
        dim as string ans = ""
        for a as longint = 1 to ubound(muls)
            value = muls(a)
            ans = plus( ans + string(2,"0") , str(value) )
        next
        
        dim as string answer = ans
        
    time2=timer
    
    time3 = timer
        dim as string real_answer = multiplier_7( num1,num1)
        real_answer = left(real_answer,len(real_answer)-1)
    time4 = timer
    
    dim as string diff = minus( real_answer , answer )
    
    print
    print num1
    print
    print real_answer
    print
    print answer
    print
    print "diff = " ; diff
    'print "loops = " ; loops
    'print "loops per digit = " ; loops / len(num1) 
    print
    print "Adder Time         = " ; time2 - time1
    print "Multiplier/-7 time = " ; time4 - time3
    
    sleep
    
loop until inkey = chr(27)

sleep
end
'===============================================================================
'===============================================================================
'Dodicats plus & Minus functions
'===============================================================================
'===============================================================================
    Function plus(_num1 As String,_num2 As String) As String
        Dim  ADDQmod(0 To 19) As Ubyte
        Dim  ADDbool(0 To 19) As Ubyte
        For z As Integer=0 To 19
            ADDQmod(z)=(z Mod 10+48)
            ADDbool(z)=(-(10<=z))
        Next z
        Var _flag=0,n_=0
        Dim As Ubyte addup=Any,addcarry=Any
        #macro finish()
        answer=Ltrim(answer,"0")
        If _flag=1 Then Swap _num2,_num1
        Return answer
        #endmacro
        If Len(_num2)>Len(_num1) Then
            Swap _num2,_num1
            _flag=1
        End If
        Var diff=Len(_num1)-Len(_num2)
        Var answer="0"+_num1
        addcarry=0
        For n_=Len(_num1)-1 To diff Step -1
            addup=_num2[n_-diff]+_num1[n_]-96
            answer[n_+1]=ADDQmod(addup+addcarry)
            addcarry=ADDbool(addup+addcarry)
        Next n_
        If addcarry=0 Then
            finish()
        End If
        If n_=-1 Then
            answer[0]=addcarry+48
            finish()
            Endif
            For n_=n_ To 0 Step -1
                addup=_num1[n_]-48
                answer[n_+1]=ADDQmod(addup+addcarry)
                addcarry=ADDbool(addup+addcarry)
                If addcarry=0 Then Exit For
            Next n_
            answer[0]=addcarry+48
            finish()
        End Function
'===============================================================================
'===============================================================================
Function minus(NUM1 As String,NUM2 As String) As String
     'Dim As String copyfirstnum=mul_num_1,copysecondnum=mul_num_2
    Dim As Byte swapflag           
    Dim As Long lenf,lens
    Dim sign As String * 1
    'Dim As String part1,part2
    Dim bigger As Byte
     'set up tables
    Dim As Ubyte Qmod(0 To 19)
    Dim bool(0 To 19) As Ubyte

    For z As Integer=0 To 19
        Qmod(z)=cubyte(z Mod 10+48)
        bool(z)=cubyte(-(10>z))
    Next z
    lenf=Len(NUM1)
    lens=Len(NUM2)
    #macro compare(numbers)
        If Lens>lenf Then bigger= -1:Goto fin
        If Lens<lenf Then bigger =0:Goto fin
        If NUM2>NUM1 Then
            bigger=-1
        Else
            bigger= 0
        End If
        fin:
    #endmacro

    compare(numbers)
    If bigger Then
        sign="-"
        Swap NUM2,NUM1
        Swap lens,lenf
        swapflag=1
    Endif
    'lenf=Len(NUM1)
    'lens=Len(NUM2)
    Dim diff As Long=lenf-lens-Sgn(lenf-lens)
    Dim As String one,two,three
    three=NUM1
    two=String(lenf-lens,"0")+NUM2
    one=NUM1
    Dim As Long n2
    Dim As Ubyte takeaway,subtractcarry
    Dim As Ubyte ten=10
    'Dim z As Long
    subtractcarry=0
    Do
         For n2=lenf-1 To diff Step -1
           takeaway= one[n2]-two[n2]+ten-subtractcarry
           three[n2]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
        Next n2
        If subtractcarry=0 Then Exit Do
        If n2=-1 Then Exit Do
        For n2=n2 To 0 Step -1
            takeaway= one[n2]-two[n2]+ten-subtractcarry
            three[n2]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
            Next n2
        Exit Do
    Loop
   
    three=Ltrim(three,"0")
    If three="" Then Return "0"
    If swapflag=1 Then Swap NUM1,NUM2
   
    Return sign+three
   
End Function
'===============================================================================
'===============================================================================
function multiplier_7(byref num1 as string, byref num2 as string) as string
   
    dim as string number1,number2
    dim as string answer,outtext
   
    dim as string int1,frac1,int2,frac2
    dim as ulongint dec,dec1,len1,len2
    dim as string str1
    dim as string sign1,sign2,outsign
   
    number1 = num1
    number2 = num2
   
    sign1 = left(number1,1)
    if sign1 = "+" or sign1 = "-" then number1 = mid(number1,2) else sign1 = ""
   
    sign2 = left(number2,1)
    if sign2 = "+" or sign2 = "-" then number2 = mid(number2,2) else sign2 = ""
   
    if (sign1 = sign2) then outsign = ""
    if (sign1 <> sign2) then outsign = "-"
   
    dec = instr(1,number1,".")
    if dec > 0 then
        int1 = left(number1,dec-1)
        frac1 = mid(number1,dec+1)
    else
        int1 = number1
        frac1 = ""
    end if
   
    dec = instr(1,number2,".")
    if dec > 0 then
        int2 = left(number2,dec-1)
        frac2 = mid(number2,dec+1)
    else
        int2 = number2
        frac2 = ""
    end if

    dec = len(frac1)+len(frac2)
    number1 = int1+frac1
    number2 = int2+frac2

    'swap numbers so that bigger number is number1 and smaller is number2
    if len(number2) > len(number1) then swap number1,number2
    if len(number1) = len(number2) then
        if val(left(number2,1)) > val(left(number1,1)) then swap number1,number2
    end if

    'make numbers equal multiple of 7 bytes
    do
        str1 = str(len(number1)/7)
        dec1 = instr(1,str1,".")
        if dec1 <> 0 then number1 = "0" + number1
    loop until dec1 = 0
    do
        str1 = str(len(number2)/7)
        dec1 = instr(1,str1,".")
        if dec1 <> 0 then number2 = "0" + number2
    loop until dec1 = 0
   
    'convert the numeric strings to use pointers
    'convert number1
    dim as string n1 = string(len(number1)*8,chr(0))
    dim as ulongint ptr ulp1
    ulp1 = cptr(ulongint ptr,strptr(n1))
    dim as longint val1
    dim as longint len_1 = 0
    dim as uinteger a
    for a = 0 to len(number1)-1 step 7
        val1 = (number1[a+0]-48)*1000000ull
        val1+= (number1[a+1]-48)*100000ull
        val1+= (number1[a+2]-48)*10000ull
        val1+= (number1[a+3]-48)*1000ull
        val1+= (number1[a+4]-48)*100ull
        val1+= (number1[a+5]-48)*10ull
        val1+= (number1[a+6]-48)*1ull
        *ulp1 = val1
        ulp1+=1
        len_1+=8
    next
    number1 = left(n1,len_1)
    n1=""
   
    'convert the numeric strings to use pointers
    'convert number2
    dim as string n2 = string(len(number2)*8,chr(0))
    dim as ulongint ptr ulp2
    ulp2 = cptr(ulongint ptr,strptr(n2))
    dim as longint val2
    dim as longint len_2 = 0
    for a = 0 to len(number2)-1 step 7
        val2 = (number2[a+0]-48)*1000000ull
        val2+= (number2[a+1]-48)*100000ull
        val2+= (number2[a+2]-48)*10000ull
        val2+= (number2[a+3]-48)*1000ull
        val2+= (number2[a+4]-48)*100ull
        val2+= (number2[a+5]-48)*10ull
        val2+= (number2[a+6]-48)*1ull
        *ulp2 = val2
        ulp2+=1
        len_2+=8
    next
    number2 = left(n2,len_2)
    n2=""
   
    'create accumulator
    answer = string( len(number1) + len(number2) + 8 , chr(0) )
    'dimension vars for the mul
    dim as longint ptr start1,stop1,start2,stop2 'use longint because the pointers go negative
    dim as longint ptr chk_1 , chk_2
    dim as longint ptr inc1,inc2
    dim as longint ptr outplace
    dim as ulongint carry
    dim as ulongint total
    dim as ulongint blocknumber1 = len(number1)/8
    dim as ulongint blocknumber2 = len(number2)/8
    dim as ulongint outblocks = len(answer)/8
   
    'set initial accumulator place
    outplace = cptr(longint ptr , strptr(answer)) + (outblocks - 1)
    'set initial pointers into number1
    start1 = cptr(longint ptr , strptr(number1))+(blocknumber1-1)
    stop1 =  cptr(longint ptr , strptr(number1))+(blocknumber1-1)
    'set initial pointers into number2
    start2 = cptr(longint ptr , strptr(number2))+(blocknumber2-1)
    stop2 =  cptr(longint ptr , strptr(number2))+(blocknumber2-1)
    'set comparison to beg of numbers
    chk_1 = cptr( longint ptr , strptr(number1))
    chk_2 = cptr( longint ptr , strptr(number2))
   
    'zero the carry
    carry = 0
   
    'begin looping thru strings multiplying
    do
        'set total to zero
        total = 0
        'we are going to be incrementing thru number2 while decrementing thru number1
        'working in opposite directions from start1 to stop1 and start2 to stop2
        'inc1 works from right to left in the top number1 string
        'inc2 works from start2 to stop 2, in the bottom number2 string, decrementing each loop.
        inc1 = start1
        inc2 = start2
        do
            total += *inc1 * *inc2
            inc1-= 1
            inc2+= 1
        loop until inc2 = stop2+1
   
        total = total + carry
        carry = total \ 1e7
        *outplace = total mod 1e7
        '*outplace = imod(total , 1e7)
       
        outplace -= 1
       
        'each loop we need to decrement stop1
        'if stop1 goes negative we reset it to zero and decrement stop2
        stop1 -= 1
        if stop1 < chk_1 then
            stop1 += 1
            stop2 -=1
            if stop2 < chk_2 then stop2+= 1
        end if
        'each loop we decrement start2 to the left
        start2 -= 1
        'if start2 goes negative we reset it to zero and decrement start1
        'start1 is the rightmost digit of number1 we need to multiply
        if start2 < chk_2 then
            start2 += 1
            start1 -= 1
            if start1 < chk_1 then start1+=1
        end if
   
    loop until outplace = cptr(ulongint ptr,strptr(answer))+1
   
    'put in the carry at the end
    if carry > 0  then *outplace = carry else *outplace = 0
   
    'convert answer back to ascii
    for a as ulongint = 1 to outblocks-1 step 1
        val1 = *outplace
        outplace +=1
        outtext = outtext + right("0000000" + str(val1),7)
    next   

    'put in the decimal point
    outtext = left(outtext,len(outtext)-dec) + "." +  mid(outtext,(len(outtext)-dec)+1)
    'trim leading zeros
    outtext = trim(outtext,"0") 'if multiplying by 1, we have a zero in front.
    outtext = outsign + outtext

    return outtext

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

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

Re: Squares

Post by dodicat »

Thanks Albert.
Works fine here on Win 10.
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@Dodiact

(!!~~OFF TOPIC~~!!)

I made a song about the hole for me nuts , and , she ate me nuts fast

Code: Select all


( Genre = Pop )

( Title = Eight Minutes Fast )

( entry music )

	do you got a whole four minutes?
	she eight minutes fast
	i got to check the time again
	while we just have ourselves a blast

caught up in the ever after
i watch the minute hand go round

a twenty one a bunny run
dig a hole and hide from the sun

and another seven minutes
a twenty eight the bunny's ate

it's time to dig another hole
get headed for the pearly gate

( music )

	do you got a whole four minutes?
	she eight minutes fast
	i got to check the time again
	while we just have ourselves a blast

watching the hand of the second
as the minute is counting down

got a thirty and bo dirty
its like downtown and twice as round

and in another two minutes
a thirty two a purty jew

it's time for the marry-go-round
and the diamond shines pink and blue

( music )

	do you got a whole four minutes?
	she eight minutes fast
	i got to check the time again
	while we just have ourselves a blast

and the minute hand keeps ticking
goind around around and round

a thirty eight a purty ate
never mind if it ain't your fate

and in just another minute
a thirty nine a purty fine

and your feeling all so happy
the funny things we make with time

( music )

	do you got a whole four minutes?
	she eight minutes fast
	i got to check the time again
	while we just have ourselves a blast

	( music )

	do you got a whole four minutes?
	she eight minutes fast
	i got to check the time again
	while we just have ourselves a blast

( exit music )

albert_redditt@yahoo.com

Albert Redditt
315 W. Carrillo St. #104
Santa Barbara, Ca. 93101 U.S.A.

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

Cascade Mul

Post by albert »

@Dodicat

I got my new mul working with strings... Here's num1 = 40 digits.
Now to convert it , to go by chunks of 7 or more digits.

Code: Select all


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

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

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

dim as double time1 , time2 , time3 , time4

screen 19

do
   
    dim as string num1 = ""
    for a as longint = 1 to 40
        num1+=str(int(rnd*10))
    next
   
    if left(num1,1) = "0" then mid(num1,1,1) = str(int(rnd*9)+1)
   
    time1=timer
   
        dim as ulongint muls( 1 to len(num1) )
            for a as longint = 1 to len(num1) step 1
                muls(a) = val(mid(num1,a,1))  ^ 2
            next
        dim as ulongint val1 = 0
        dim as ulongint val2 = 0
        dim as ulongint value = 0
        dim as string ans = ""
        dim as string str_value = ""
        for place as longint = 2 to len(num1)
            val1 = val(mid(num1,place,1))
            ans = ""
            for b as longint = 1 to place-1
                val2= val(mid(num1,b,1))
                ans = plus( ans , str(val1*val2) )+"0"
            next
            ans = plus( ans , ans )
            str_value = plus( str_value+"00" , ans )
        next
       
        ans = ""
        for a as longint = 1 to ubound(muls)
            value = muls(a)
            ans = plus( ans + string(2,"0") , str(value) )
        next
       
        dim as string answer = ans
        answer = plus( answer , str_value )
        
        
    time2 = timer
   
    time3 = timer
        dim as string real_answer = multiplier_7( num1,num1)
        real_answer = left(real_answer,len(real_answer)-1)
    time4 = timer
   
    dim as string diff = minus( real_answer , answer )
   
    print
    print num1
    print
    print real_answer
    print
    print answer
    print
    print "diff = " ; diff
    'print "loops = " ; loops
    'print "loops per digit = " ; loops / len(num1)
    print
    print "Adder Time         = " ; time2 - time1
    print "Multiplier/-7 time = " ; time4 - time3
   
    sleep
   
loop until inkey = chr(27)

sleep
end
'===============================================================================
'===============================================================================
'Dodicats plus & Minus functions
'===============================================================================
'===============================================================================
    Function plus(_num1 As String,_num2 As String) As String
        Dim  ADDQmod(0 To 19) As Ubyte
        Dim  ADDbool(0 To 19) As Ubyte
        For z As Integer=0 To 19
            ADDQmod(z)=(z Mod 10+48)
            ADDbool(z)=(-(10<=z))
        Next z
        Var _flag=0,n_=0
        Dim As Ubyte addup=Any,addcarry=Any
        #macro finish()
        answer=Ltrim(answer,"0")
        If _flag=1 Then Swap _num2,_num1
        Return answer
        #endmacro
        If Len(_num2)>Len(_num1) Then
            Swap _num2,_num1
            _flag=1
        End If
        Var diff=Len(_num1)-Len(_num2)
        Var answer="0"+_num1
        addcarry=0
        For n_=Len(_num1)-1 To diff Step -1
            addup=_num2[n_-diff]+_num1[n_]-96
            answer[n_+1]=ADDQmod(addup+addcarry)
            addcarry=ADDbool(addup+addcarry)
        Next n_
        If addcarry=0 Then
            finish()
        End If
        If n_=-1 Then
            answer[0]=addcarry+48
            finish()
            Endif
            For n_=n_ To 0 Step -1
                addup=_num1[n_]-48
                answer[n_+1]=ADDQmod(addup+addcarry)
                addcarry=ADDbool(addup+addcarry)
                If addcarry=0 Then Exit For
            Next n_
            answer[0]=addcarry+48
            finish()
        End Function
'===============================================================================
'===============================================================================
Function minus(NUM1 As String,NUM2 As String) As String
     'Dim As String copyfirstnum=mul_num_1,copysecondnum=mul_num_2
    Dim As Byte swapflag           
    Dim As Long lenf,lens
    Dim sign As String * 1
    'Dim As String part1,part2
    Dim bigger As Byte
     'set up tables
    Dim As Ubyte Qmod(0 To 19)
    Dim bool(0 To 19) As Ubyte

    For z As Integer=0 To 19
        Qmod(z)=cubyte(z Mod 10+48)
        bool(z)=cubyte(-(10>z))
    Next z
    lenf=Len(NUM1)
    lens=Len(NUM2)
    #macro compare(numbers)
        If Lens>lenf Then bigger= -1:Goto fin
        If Lens<lenf Then bigger =0:Goto fin
        If NUM2>NUM1 Then
            bigger=-1
        Else
            bigger= 0
        End If
        fin:
    #endmacro

    compare(numbers)
    If bigger Then
        sign="-"
        Swap NUM2,NUM1
        Swap lens,lenf
        swapflag=1
    Endif
    'lenf=Len(NUM1)
    'lens=Len(NUM2)
    Dim diff As Long=lenf-lens-Sgn(lenf-lens)
    Dim As String one,two,three
    three=NUM1
    two=String(lenf-lens,"0")+NUM2
    one=NUM1
    Dim As Long n2
    Dim As Ubyte takeaway,subtractcarry
    Dim As Ubyte ten=10
    'Dim z As Long
    subtractcarry=0
    Do
         For n2=lenf-1 To diff Step -1
           takeaway= one[n2]-two[n2]+ten-subtractcarry
           three[n2]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
        Next n2
        If subtractcarry=0 Then Exit Do
        If n2=-1 Then Exit Do
        For n2=n2 To 0 Step -1
            takeaway= one[n2]-two[n2]+ten-subtractcarry
            three[n2]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
            Next n2
        Exit Do
    Loop
   
    three=Ltrim(three,"0")
    If three="" Then Return "0"
    If swapflag=1 Then Swap NUM1,NUM2
   
    Return sign+three
   
End Function
'===============================================================================
'===============================================================================
function multiplier_7(byref num1 as string, byref num2 as string) as string
   
    dim as string number1,number2
    dim as string answer,outtext
   
    dim as string int1,frac1,int2,frac2
    dim as ulongint dec,dec1,len1,len2
    dim as string str1
    dim as string sign1,sign2,outsign
   
    number1 = num1
    number2 = num2
   
    sign1 = left(number1,1)
    if sign1 = "+" or sign1 = "-" then number1 = mid(number1,2) else sign1 = ""
   
    sign2 = left(number2,1)
    if sign2 = "+" or sign2 = "-" then number2 = mid(number2,2) else sign2 = ""
   
    if (sign1 = sign2) then outsign = ""
    if (sign1 <> sign2) then outsign = "-"
   
    dec = instr(1,number1,".")
    if dec > 0 then
        int1 = left(number1,dec-1)
        frac1 = mid(number1,dec+1)
    else
        int1 = number1
        frac1 = ""
    end if
   
    dec = instr(1,number2,".")
    if dec > 0 then
        int2 = left(number2,dec-1)
        frac2 = mid(number2,dec+1)
    else
        int2 = number2
        frac2 = ""
    end if

    dec = len(frac1)+len(frac2)
    number1 = int1+frac1
    number2 = int2+frac2

    'swap numbers so that bigger number is number1 and smaller is number2
    if len(number2) > len(number1) then swap number1,number2
    if len(number1) = len(number2) then
        if val(left(number2,1)) > val(left(number1,1)) then swap number1,number2
    end if

    'make numbers equal multiple of 7 bytes
    do
        str1 = str(len(number1)/7)
        dec1 = instr(1,str1,".")
        if dec1 <> 0 then number1 = "0" + number1
    loop until dec1 = 0
    do
        str1 = str(len(number2)/7)
        dec1 = instr(1,str1,".")
        if dec1 <> 0 then number2 = "0" + number2
    loop until dec1 = 0
   
    'convert the numeric strings to use pointers
    'convert number1
    dim as string n1 = string(len(number1)*8,chr(0))
    dim as ulongint ptr ulp1
    ulp1 = cptr(ulongint ptr,strptr(n1))
    dim as longint val1
    dim as longint len_1 = 0
    dim as uinteger a
    for a = 0 to len(number1)-1 step 7
        val1 = (number1[a+0]-48)*1000000ull
        val1+= (number1[a+1]-48)*100000ull
        val1+= (number1[a+2]-48)*10000ull
        val1+= (number1[a+3]-48)*1000ull
        val1+= (number1[a+4]-48)*100ull
        val1+= (number1[a+5]-48)*10ull
        val1+= (number1[a+6]-48)*1ull
        *ulp1 = val1
        ulp1+=1
        len_1+=8
    next
    number1 = left(n1,len_1)
    n1=""
   
    'convert the numeric strings to use pointers
    'convert number2
    dim as string n2 = string(len(number2)*8,chr(0))
    dim as ulongint ptr ulp2
    ulp2 = cptr(ulongint ptr,strptr(n2))
    dim as longint val2
    dim as longint len_2 = 0
    for a = 0 to len(number2)-1 step 7
        val2 = (number2[a+0]-48)*1000000ull
        val2+= (number2[a+1]-48)*100000ull
        val2+= (number2[a+2]-48)*10000ull
        val2+= (number2[a+3]-48)*1000ull
        val2+= (number2[a+4]-48)*100ull
        val2+= (number2[a+5]-48)*10ull
        val2+= (number2[a+6]-48)*1ull
        *ulp2 = val2
        ulp2+=1
        len_2+=8
    next
    number2 = left(n2,len_2)
    n2=""
   
    'create accumulator
    answer = string( len(number1) + len(number2) + 8 , chr(0) )
    'dimension vars for the mul
    dim as longint ptr start1,stop1,start2,stop2 'use longint because the pointers go negative
    dim as longint ptr chk_1 , chk_2
    dim as longint ptr inc1,inc2
    dim as longint ptr outplace
    dim as ulongint carry
    dim as ulongint total
    dim as ulongint blocknumber1 = len(number1)/8
    dim as ulongint blocknumber2 = len(number2)/8
    dim as ulongint outblocks = len(answer)/8
   
    'set initial accumulator place
    outplace = cptr(longint ptr , strptr(answer)) + (outblocks - 1)
    'set initial pointers into number1
    start1 = cptr(longint ptr , strptr(number1))+(blocknumber1-1)
    stop1 =  cptr(longint ptr , strptr(number1))+(blocknumber1-1)
    'set initial pointers into number2
    start2 = cptr(longint ptr , strptr(number2))+(blocknumber2-1)
    stop2 =  cptr(longint ptr , strptr(number2))+(blocknumber2-1)
    'set comparison to beg of numbers
    chk_1 = cptr( longint ptr , strptr(number1))
    chk_2 = cptr( longint ptr , strptr(number2))
   
    'zero the carry
    carry = 0
   
    'begin looping thru strings multiplying
    do
        'set total to zero
        total = 0
        'we are going to be incrementing thru number2 while decrementing thru number1
        'working in opposite directions from start1 to stop1 and start2 to stop2
        'inc1 works from right to left in the top number1 string
        'inc2 works from start2 to stop 2, in the bottom number2 string, decrementing each loop.
        inc1 = start1
        inc2 = start2
        do
            total += *inc1 * *inc2
            inc1-= 1
            inc2+= 1
        loop until inc2 = stop2+1
   
        total = total + carry
        carry = total \ 1e7
        *outplace = total mod 1e7
        '*outplace = imod(total , 1e7)
       
        outplace -= 1
       
        'each loop we need to decrement stop1
        'if stop1 goes negative we reset it to zero and decrement stop2
        stop1 -= 1
        if stop1 < chk_1 then
            stop1 += 1
            stop2 -=1
            if stop2 < chk_2 then stop2+= 1
        end if
        'each loop we decrement start2 to the left
        start2 -= 1
        'if start2 goes negative we reset it to zero and decrement start1
        'start1 is the rightmost digit of number1 we need to multiply
        if start2 < chk_2 then
            start2 += 1
            start1 -= 1
            if start1 < chk_1 then start1+=1
        end if
   
    loop until outplace = cptr(ulongint ptr,strptr(answer))+1
   
    'put in the carry at the end
    if carry > 0  then *outplace = carry else *outplace = 0
   
    'convert answer back to ascii
    for a as ulongint = 1 to outblocks-1 step 1
        val1 = *outplace
        outplace +=1
        outtext = outtext + right("0000000" + str(val1),7)
    next   

    'put in the decimal point
    outtext = left(outtext,len(outtext)-dec) + "." +  mid(outtext,(len(outtext)-dec)+1)
    'trim leading zeros
    outtext = trim(outtext,"0") 'if multiplying by 1, we have a zero in front.
    outtext = outsign + outtext

    return outtext

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

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

Re: Squares

Post by albert »

@Dodicat

it takes too long... Can you speed up your plus() function. maybe stepping it by 18 digits ??

Here it is with pointers....

Code: Select all


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

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

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

dim as double time1 , time2 , time3 , time4

screen 19

do
   
    dim as string num1 = ""
    for a as longint = 1 to 1000
        num1+=str(int(rnd*10))
    next
    if left(num1,1) = "0" then mid(num1,1,1) = str(int(rnd*9)+1)
    
    dim as string number1 = num1
    
    time1=timer
        
        dim as longint size = 7
        dim as string str1
        dim as longint dec1
        do
            str1=str(len(num1)/size)
            dec1=instr(1,str1,".")
            if dec1<>0 then num1="0"+num1
        loop until dec1=0
        
        
        dim as ulongint arrays = len(num1)\size
        dim as string answer = ""
        for a as longint = 1 to len(num1) step size
            answer = plus( answer + string(size*2,"0") , str(valulng(mid(num1,a,size))^2) )
        next
                
        'convert the numeric strings to use pointers
        'convert number1
        dim as string n1 = string(len(num1)*8,chr(0))
        dim as ulongint ptr ulp = cptr( ulongint ptr , strptr(n1) )
        dim as longint value
        dim as longint len_1 = 0
        for a as longint = 0 to len(num1)-1 step 7
            value = (num1[a+0]-48)*1e6
            value+= (num1[a+1]-48)*1e5
            value+= (num1[a+2]-48)*1e4
            value+= (num1[a+3]-48)*1e3
            value+= (num1[a+4]-48)*1e2
            value+= (num1[a+5]-48)*1e1
            value+= (num1[a+6]-48)*1
            *ulp = value
            ulp+=1
            len_1+=8
        next
        num1 = left(n1,len_1)
        n1=""

        dim as ulongint val1 = 0
        dim as ulongint val2 = 0
        dim as string ans = ""
        dim as string str_value = ""
        dim as ulongint ptr ulp1 = cptr( ulongint ptr , strptr(num1) )
        dim as ulongint ptr ulp2
        for place as longint = 2 to arrays step 1
            ulp1+=1
            val1 = *ulp1 'valulng( mid(num1,place,size) )
            ans = ""
            ulp2 = cptr( ulongint ptr , strptr(num1) )
            value = 0
            for b as longint = 1 to place-1 step 1
                val2 = *ulp2
                ulp2+=1
                ans = plus( ans , str(val1*val2*2) ) + string(size,"0")
            next
            str_value = plus( str_value + string(size*2,"0") , ans )
        next
        answer = plus( answer , str_value )
        
        
    time2 = timer
   
    time3 = timer
        dim as string real_answer = multiplier_7( number1 , number1 )
        real_answer = left(real_answer,len(real_answer)-1)
    time4 = timer
   
    dim as string diff = minus( real_answer , answer )
   
    print
    print number1
    print
    print real_answer
    print
    print answer
    print
    print "diff = " ; diff
    'print "loops = " ; loops
    'print "loops per digit = " ; loops / len(num1)
    print "Digits = " ; len(num1)
    print
    print "Adder Time         = " ; time2 - time1
    print "Multiplier/-7 time = " ; time4 - time3
   
    sleep
   
loop until inkey = chr(27)

sleep
end
'===============================================================================
'===============================================================================
'Dodicats plus & Minus functions
'===============================================================================
'===============================================================================
    Function plus(_num1 As String,_num2 As String) As String
        Dim  ADDQmod(0 To 19) As Ubyte
        Dim  ADDbool(0 To 19) As Ubyte
        For z As Integer=0 To 19
            ADDQmod(z)=(z Mod 10+48)
            ADDbool(z)=(-(10<=z))
        Next z
        Var _flag=0,n_=0
        Dim As Ubyte addup=Any,addcarry=Any
        #macro finish()
        answer=Ltrim(answer,"0")
        If _flag=1 Then Swap _num2,_num1
        Return answer
        #endmacro
        If Len(_num2)>Len(_num1) Then
            Swap _num2,_num1
            _flag=1
        End If
        Var diff=Len(_num1)-Len(_num2)
        Var answer="0"+_num1
        addcarry=0
        For n_=Len(_num1)-1 To diff Step -1
            addup=_num2[n_-diff]+_num1[n_]-96
            answer[n_+1]=ADDQmod(addup+addcarry)
            addcarry=ADDbool(addup+addcarry)
        Next n_
        If addcarry=0 Then
            finish()
        End If
        If n_=-1 Then
            answer[0]=addcarry+48
            finish()
            Endif
            For n_=n_ To 0 Step -1
                addup=_num1[n_]-48
                answer[n_+1]=ADDQmod(addup+addcarry)
                addcarry=ADDbool(addup+addcarry)
                If addcarry=0 Then Exit For
            Next n_
            answer[0]=addcarry+48
            finish()
        End Function
'===============================================================================
'===============================================================================
Function minus(NUM1 As String,NUM2 As String) As String
     'Dim As String copyfirstnum=mul_num_1,copysecondnum=mul_num_2
    Dim As Byte swapflag           
    Dim As Long lenf,lens
    Dim sign As String * 1
    'Dim As String part1,part2
    Dim bigger As Byte
     'set up tables
    Dim As Ubyte Qmod(0 To 19)
    Dim bool(0 To 19) As Ubyte

    For z As Integer=0 To 19
        Qmod(z)=cubyte(z Mod 10+48)
        bool(z)=cubyte(-(10>z))
    Next z
    lenf=Len(NUM1)
    lens=Len(NUM2)
    #macro compare(numbers)
        If Lens>lenf Then bigger= -1:Goto fin
        If Lens<lenf Then bigger =0:Goto fin
        If NUM2>NUM1 Then
            bigger=-1
        Else
            bigger= 0
        End If
        fin:
    #endmacro

    compare(numbers)
    If bigger Then
        sign="-"
        Swap NUM2,NUM1
        Swap lens,lenf
        swapflag=1
    Endif
    'lenf=Len(NUM1)
    'lens=Len(NUM2)
    Dim diff As Long=lenf-lens-Sgn(lenf-lens)
    Dim As String one,two,three
    three=NUM1
    two=String(lenf-lens,"0")+NUM2
    one=NUM1
    Dim As Long n2
    Dim As Ubyte takeaway,subtractcarry
    Dim As Ubyte ten=10
    'Dim z As Long
    subtractcarry=0
    Do
         For n2=lenf-1 To diff Step -1
           takeaway= one[n2]-two[n2]+ten-subtractcarry
           three[n2]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
        Next n2
        If subtractcarry=0 Then Exit Do
        If n2=-1 Then Exit Do
        For n2=n2 To 0 Step -1
            takeaway= one[n2]-two[n2]+ten-subtractcarry
            three[n2]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
            Next n2
        Exit Do
    Loop
   
    three=Ltrim(three,"0")
    If three="" Then Return "0"
    If swapflag=1 Then Swap NUM1,NUM2
   
    Return sign+three
   
End Function
'===============================================================================
'===============================================================================
function multiplier_7(byref num1 as string, byref num2 as string) as string
   
    dim as string number1,number2
    dim as string answer,outtext
   
    dim as string int1,frac1,int2,frac2
    dim as ulongint dec,dec1,len1,len2
    dim as string str1
    dim as string sign1,sign2,outsign
   
    number1 = num1
    number2 = num2
   
    sign1 = left(number1,1)
    if sign1 = "+" or sign1 = "-" then number1 = mid(number1,2) else sign1 = ""
   
    sign2 = left(number2,1)
    if sign2 = "+" or sign2 = "-" then number2 = mid(number2,2) else sign2 = ""
   
    if (sign1 = sign2) then outsign = ""
    if (sign1 <> sign2) then outsign = "-"
   
    dec = instr(1,number1,".")
    if dec > 0 then
        int1 = left(number1,dec-1)
        frac1 = mid(number1,dec+1)
    else
        int1 = number1
        frac1 = ""
    end if
   
    dec = instr(1,number2,".")
    if dec > 0 then
        int2 = left(number2,dec-1)
        frac2 = mid(number2,dec+1)
    else
        int2 = number2
        frac2 = ""
    end if

    dec = len(frac1)+len(frac2)
    number1 = int1+frac1
    number2 = int2+frac2

    'swap numbers so that bigger number is number1 and smaller is number2
    if len(number2) > len(number1) then swap number1,number2
    if len(number1) = len(number2) then
        if val(left(number2,1)) > val(left(number1,1)) then swap number1,number2
    end if

    'make numbers equal multiple of 7 bytes
    do
        str1 = str(len(number1)/7)
        dec1 = instr(1,str1,".")
        if dec1 <> 0 then number1 = "0" + number1
    loop until dec1 = 0
    do
        str1 = str(len(number2)/7)
        dec1 = instr(1,str1,".")
        if dec1 <> 0 then number2 = "0" + number2
    loop until dec1 = 0
   
    'convert the numeric strings to use pointers
    'convert number1
    dim as string n1 = string(len(number1)*8,chr(0))
    dim as ulongint ptr ulp1
    ulp1 = cptr(ulongint ptr,strptr(n1))
    dim as longint val1
    dim as longint len_1 = 0
    dim as uinteger a
    for a = 0 to len(number1)-1 step 7
        val1 = (number1[a+0]-48)*1000000ull
        val1+= (number1[a+1]-48)*100000ull
        val1+= (number1[a+2]-48)*10000ull
        val1+= (number1[a+3]-48)*1000ull
        val1+= (number1[a+4]-48)*100ull
        val1+= (number1[a+5]-48)*10ull
        val1+= (number1[a+6]-48)*1ull
        *ulp1 = val1
        ulp1+=1
        len_1+=8
    next
    number1 = left(n1,len_1)
    n1=""
   
    'convert the numeric strings to use pointers
    'convert number2
    dim as string n2 = string(len(number2)*8,chr(0))
    dim as ulongint ptr ulp2
    ulp2 = cptr(ulongint ptr,strptr(n2))
    dim as longint val2
    dim as longint len_2 = 0
    for a = 0 to len(number2)-1 step 7
        val2 = (number2[a+0]-48)*1000000ull
        val2+= (number2[a+1]-48)*100000ull
        val2+= (number2[a+2]-48)*10000ull
        val2+= (number2[a+3]-48)*1000ull
        val2+= (number2[a+4]-48)*100ull
        val2+= (number2[a+5]-48)*10ull
        val2+= (number2[a+6]-48)*1ull
        *ulp2 = val2
        ulp2+=1
        len_2+=8
    next
    number2 = left(n2,len_2)
    n2=""
   
    'create accumulator
    answer = string( len(number1) + len(number2) + 8 , chr(0) )
    'dimension vars for the mul
    dim as longint ptr start1,stop1,start2,stop2 'use longint because the pointers go negative
    dim as longint ptr chk_1 , chk_2
    dim as longint ptr inc1,inc2
    dim as longint ptr outplace
    dim as ulongint carry
    dim as ulongint total
    dim as ulongint blocknumber1 = len(number1)/8
    dim as ulongint blocknumber2 = len(number2)/8
    dim as ulongint outblocks = len(answer)/8
   
    'set initial accumulator place
    outplace = cptr(longint ptr , strptr(answer)) + (outblocks - 1)
    'set initial pointers into number1
    start1 = cptr(longint ptr , strptr(number1))+(blocknumber1-1)
    stop1 =  cptr(longint ptr , strptr(number1))+(blocknumber1-1)
    'set initial pointers into number2
    start2 = cptr(longint ptr , strptr(number2))+(blocknumber2-1)
    stop2 =  cptr(longint ptr , strptr(number2))+(blocknumber2-1)
    'set comparison to beg of numbers
    chk_1 = cptr( longint ptr , strptr(number1))
    chk_2 = cptr( longint ptr , strptr(number2))
   
    'zero the carry
    carry = 0
   
    'begin looping thru strings multiplying
    do
        'set total to zero
        total = 0
        'we are going to be incrementing thru number2 while decrementing thru number1
        'working in opposite directions from start1 to stop1 and start2 to stop2
        'inc1 works from right to left in the top number1 string
        'inc2 works from start2 to stop 2, in the bottom number2 string, decrementing each loop.
        inc1 = start1
        inc2 = start2
        do
            total += *inc1 * *inc2
            inc1-= 1
            inc2+= 1
        loop until inc2 = stop2+1
   
        total = total + carry
        carry = total \ 1e7
        *outplace = total mod 1e7
        '*outplace = imod(total , 1e7)
       
        outplace -= 1
       
        'each loop we need to decrement stop1
        'if stop1 goes negative we reset it to zero and decrement stop2
        stop1 -= 1
        if stop1 < chk_1 then
            stop1 += 1
            stop2 -=1
            if stop2 < chk_2 then stop2+= 1
        end if
        'each loop we decrement start2 to the left
        start2 -= 1
        'if start2 goes negative we reset it to zero and decrement start1
        'start1 is the rightmost digit of number1 we need to multiply
        if start2 < chk_2 then
            start2 += 1
            start1 -= 1
            if start1 < chk_1 then start1+=1
        end if
   
    loop until outplace = cptr(ulongint ptr,strptr(answer))+1
   
    'put in the carry at the end
    if carry > 0  then *outplace = carry else *outplace = 0
   
    'convert answer back to ascii
    for a as ulongint = 1 to outblocks-1 step 1
        val1 = *outplace
        outplace +=1
        outtext = outtext + right("0000000" + str(val1),7)
    next   

    'put in the decimal point
    outtext = left(outtext,len(outtext)-dec) + "." +  mid(outtext,(len(outtext)-dec)+1)
    'trim leading zeros
    outtext = trim(outtext,"0") 'if multiplying by 1, we have a zero in front.
    outtext = outsign + outtext

    return outtext

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

Locked