Squares

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

Re: Squares

Postby albert » Jun 28, 2018 16:16

@dodicat

The new multiplier is slower than expected... it's a nogo
albert
Posts: 5247
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jul 03, 2018 16:38

If your multiplier gives the wrong answer then its a multip-liar

I'm working on as new different one
albert
Posts: 5247
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jul 04, 2018 2:22

Hello Guys!!

My newest multiplier... only does 7 digits so far. I'm working to make it work with long strings..

Code: Select all


screen 19

do
   
    randomize
    dim as string num1
    for a as longint =  1 to 7  step 1
        num1+=str(int(rnd*10))
    next
    if left(num1,1) = "0" then mid(num1,1,1)=str(int(rnd*9)+1)
   
    '===============================================================================
    dim as double n1 = 0
    dim as double n2 = 0
    dim as ulongint loops = 0
    dim as ulongint ans( 1 )
    dim as ulongint num( 1 )
    num(1) = val(num1)
   
    print num1

    do
        loops+=1
        n1+=1e5
        for a as longint = ubound( num ) to 1 step -1
            ans(a)+=num(a)*1e5
        next
    loop until n1 > valulng(num1)-1e5 * 1.25
 
    do
        loops+=1
        n1+=1e4
        for a as longint = ubound( num ) to 1 step -1
            ans(a)+=num(a)*1e4
        next
    loop until n1 > valulng(num1)-1e4 * 1.25

    do
        loops+=1
        n1+=1e3
        for a as longint = ubound( num ) to 1 step -1
            ans(a)+=num(a)*1e3
        next
    loop until n1 > valulng(num1)-1e3*1.25
   
    do
        loops+=1
        n1+=1e2
        for a as longint = ubound( num ) to 1 step -1
                ans(a)+=num(a)*1e2
        next
    loop until n1 > valulng(num1)-1e2*1.25
   
    do
        loops+=1
        n1+=1e1
        for a as longint = ubound( num ) to 1 step -1
            ans(a)+=num(a)*1e1
        next
    loop until n1 > valulng(num1)-1e1*1.25
   
    do
        loops+=1
        n1+=1
        for a as longint = ubound( num ) to 1 step -1
            ans(a)+=num(a)*1
        next
    loop until n1 = valulng(num1)
   
    for a as longint = 1 to ubound(ans)
        print ans(a) ; " " ;
        n2+=ans(a)
        n2*=10
    next
    n2\=10
    '===============================================================================
   
    print
    locate ,1  : print "num1    = " ; num1
    locate ,1  : print "n1     = " ; n1
    locate ,1  : print "n1 * n1 = " ; valulng(num1)*valulng(num1)
    locate ,1  : print "n2      =" ; n2
    locate ,1  : print "loops   = " ; loops
   
    print
    print "Press a key to continue.."
    sleep

loop until inkey = chr(27)
'===============================================================================
sleep
end

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

Re: Squares

Postby albert » Jul 05, 2018 23:50

@Dodicat

My newest multiplier.... its 5 times slower than my multiplier_7 at 100x100 digits.
I've got to convert it to use pointers yet..

It currently steps by 1's , I've got to make it step by 7 digits..


Code: Select all


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

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

screen 19

do
   
    randomize
    dim as string num1
    for a as longint =  1 to 100  step 1
        num1+=str(int(rnd*10))
    next
    if left(num1,1) = "0" then mid(num1,1,1)=str(int(rnd*9)+1)
   
    dim as string num2
    for a as longint =  1 to 100  step 1
        num2+=str(int(rnd*10))
    next
    if left(num2,1) = "0" then mid(num2,1,1)=str(int(rnd*9)+1)
   
   
    if num2 > num1 then swap num2 , num1
   
    dim as double time1
    dim as double time2
    dim as double time3
    dim as double time4
   
    time1 = timer
    '===============================================================================
   
    dim as ulongint n1( 1 to len(num1) )
    dim as ulongint n2( 1 to len(num2) )
    dim as ulongint ans( 1 to len(num1) + len(num2) )
   
    for a as longint = len(num1) to 1 step -1
        n1(a) = val(mid(num1,a,1) )
    next
    for a as longint = len(num2) to 1 step -1
        n2(a) = val(mid(num2,a,1) )
    next
   
    dim as ulongint place1 = len(num1)
    dim as ulongint place_out = ubound(ans)
    dim as ulongint start = len(num1) + len(num2)
    dim as ulongint place = 0
    for a as longint = place1 to 1 step -1
        for b as longint = len(num2) - place  to 1 step -1
            ans(place_out)+= n1(a)  * n2(b)
            'print ans(place_out) ; " " ;
            place_out-=1
        next
        place1-=1
        start-=1
        place_out = start
    next
       
    dim as ulongint val1 = 0
    dim as ulongint carry = 0
    dim as string my_answer
    for a as longint = ubound(ans) to 1 step -1
        val1 = (ans(a)) + carry
        my_answer = str(val1 mod 10) + my_answer
        carry = val1 \ 10
    next
    if carry > 0  then my_answer = str(carry) + my_answer
   
    '===============================================================================
    time2 = timer
   
    time3 = timer
        dim as string mul_answer = multiplier_7( num1,num2)
        mul_answer = left(mul_answer,len(mul_answer)-1)
    time4 = timer
   
    dim as string difference = minus( mul_answer , my_answer )
   
    print
    locate ,1  : print "num1    = " ; num1
    locate ,1  : print "num2    = " ; num2
    locate ,1  : print "n1 * n1= " ; mul_answer
    locate ,1  : print "answer = " ; my_answer
   
    print
    locate ,1  : print "difference = " ; difference
    print
   
    locate ,1  : print "new mul time =  " ; time2-time1
    locate ,1  : print "old mul time =  " ; time4-time3
   
    if difference <> "0" then sleep
   
    if inkey = " " then sleep
    if inkey = chr(27) then sleep : end
   
loop until inkey = chr(27)
'===============================================================================
sleep
end

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

Re: Squares

Postby albert » Jul 06, 2018 1:28

@Dodicat

Here it is stepping by 7's with pointers...100,000 x 100,000 digits.

It's a No Go, it's twice as slow as multiplier_7

Code: Select all


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

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

screen 19

do
   
    randomize
    dim as string num1
    for a as longint =  1 to 100000 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 100000  step 1
        num2+=str(int(rnd*10))
    next
    if left(num2,1) = "0" then mid(num2,1,1)=str(int(rnd*9)+1)
   
   
    if num2 > num1 then swap num2 , num1
   
    dim as double time1
    dim as double time2
    dim as double time3
    dim as double time4
   
    time1 = timer
    '===============================================================================
   
    dim as string str1
    dim as ulongint dec1
    do
        str1 = str(len(num1)/7)
        dec1=instr(1,str1,".")
        if dec1 <> 0 then num1 = "0" + num1
    loop until dec1=0
    do
        str1 = str(len(num2)/7)
        dec1=instr(1,str1,".")
        if dec1 <> 0 then num2 = "0" + num2
    loop until dec1=0
   
    dim as ulongint n1( 1 to len(num1) \ 7 )
    dim as ulongint n2( 1 to len(num2) \ 7 )
    dim as ulongint ele
   
    ele = ubound(n1)
    for a as longint = len(num1)-6 to 1 step -7
        n1(ele) = val(mid(num1,a,7) )
        ele-=1
    next
   
    ele = ubound(n2)
    for a as longint = len(num2) -6 to 1 step -7
        n2(ele) = val(mid(num2,a,7) )
        ele-=1
    next
   
    dim as ulongint ans( 1 to ubound(n1) + ubound(n2) )
   
    dim as ulongint place1 = ubound(n1)
    dim as ulongint place_out = ubound(ans)
    dim as ulongint start = ubound(ans)
    dim as ulongint place = 0
    for a as ulongint ptr = cptr( ulongint ptr , varptr(n1(ubound(n1))) ) to cptr(ulongint ptr , varptr((n1(1))) ) step -1
        for b as ulongint ptr = cptr( ulongint ptr , varptr(n2(ubound(n2))) ) to cptr(ulongint ptr , varptr((n2(1))) ) step -1
            ans(place_out)+= *a * *b
            place_out-=1
        next
        place1-=1
        start-=1
        place_out = start
    next
       
    dim as ulongint val1 = 0
    dim as ulongint carry = 0
    dim as string my_answer
    for a as longint = ubound(ans) to 1 step -1
        val1 = (ans(a)) + carry
        my_answer = right( "0000000" + str(val1 mod 1e7),7) + my_answer
        carry = val1 \ 1e7
    next
    if carry > 0  then my_answer = str(carry) + my_answer
   
    '===============================================================================
    time2 = timer
   
    time3 = timer
        dim as string mul_answer = multiplier_7( num1,num2)
        mul_answer = left(mul_answer,len(mul_answer)-1)
    time4 = timer
   
    dim as string difference = minus( mul_answer , my_answer )
   
    print
    locate ,1  : print "num1    = " ; num1
    locate ,1  : print "num2    = " ; num2
    locate ,1  : print "n1 * n1= " ; mul_answer
    locate ,1  : print "answer = " ; my_answer
   
    print
    locate ,1  : print "difference = " ; difference
    print
   
    locate ,1  : print "new mul time =  " ; time2-time1
    locate ,1  : print "old mul time =  " ; time4-time3
   
    if difference <> "0" then sleep
   
    if inkey = " " then sleep
    if inkey = chr(27) then sleep : end
   
loop until inkey = chr(27)
'===============================================================================
sleep
end

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

Re: Squares

Postby albert » Jul 16, 2018 23:06

@Dodicat

I figured one thing out...

On a rectangle to figure the area, how ever you manipulate one side you have to do the opposite to the other side...

if you divide one side by 10 then you have to multiply the other side by 10..etc..
if you double one side , then you have to half the other side..
Richard
Posts: 2958
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » Jul 17, 2018 2:13

Well found !

So if the rectangle area a, is side length x, times side length y;
a = x * y
You found the area does not change if you use; a = (x*c) * (y/c)

Because; a = x*c * y/c
so; a = x * y * c/c
and; c/c must = 1;

But only so long as c <> 0.
dodicat
Posts: 5991
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Jul 17, 2018 11:30

Thanks Albert.
About one second difference foe 100000 digits.

Regarding your rectangle, If a shape was drawn on the rectangle and the rectangle was re-shaped as you have described, keeping it's area the same, would the area of the shape remain the same?

Within the limits of integer pixels:

Code: Select all

 
'resize an image
Function resize(im As Any Ptr,Wdth As Single,Hght As Single,dx As Long=0,dy As Long=0) As Any Ptr
    #define putpixel(_x,_y,colour)    *Cptr(Ulong Ptr,rowS+ (_y)*pitchS+ (_x) Shl 2)  =(colour)
    #define _getpixel(_x,_y)           *Cptr(Ulong Ptr,row + (_y)*pitch + (_x) Shl 2)
    #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))\((b)-(a))+(c)
    Static As Integer pitch,pitchs
    Static As Any Ptr row,rowS
    Static As Ulong Ptr pixel,pixels
    Static As Integer ddx,ddy,resultx,resulty
    Imageinfo im,ddx,ddy,,pitch,row
    Dim As Any Ptr im2=Imagecreate(Wdth-dx,Hght-dy)
    Imageinfo im2,,,,pitchS,rowS
    For y As Long=0+dy To Hght-1 -dy
        resulty=map(0,Hght,y,0,ddy)
        For x As Long=0+dx To Wdth-1 -dx
            resultx=map(0,Wdth,x,0,ddx)
            putpixel(x,y,_getpixel(resultx,resulty))
        Next x
    Next y
    Return im2
End Function
'count the pixels in the shape
Function getshapearea(i As Any Ptr) As Single
    Dim As integer ctr,w,h
    Imageinfo i,w,h
    For x As Long=0 To w
        For y As Long=0 To h
            If Point(x,y,i)=Rgb(200,0,0) Then ctr+=1
        Next
    Next
    Return ctr
End Function
'average of 10 shape areas
Function average(a() As String) As Double
    Dim As Double av
    For n As Long=Lbound(a) To Ubound(a)
        av+=Val(a(n))
    Next
    Return av/Ubound(a)
End Function
'keep a record of 10 areas
Sub updatehistory(a() As String,nxt As String)
    For n As Long=Lbound(a) To Ubound(a)-1
        a(n)=a(n+1)
    Next
    a(Ubound(a))=nxt
End Sub
'screen display of history
Sub showhistory(a() As String,row As Long,col As Long)
    Locate row,col
    Print "Shape Area history"
    For n As Long=Lbound(a) To Ubound(a)
        Locate ,col
        If Len(a(n)) Then Print a(n)
    Next
    Print
    If a(Lbound(a))<>"" Then
        Locate row+12,col
        Print "History average"
        Locate ,col
        Print str(average(a()))
    End If
End Sub
'draw a filled pentagon
Sub pentagon(cx As Long,cy As Long,size As Long,col As Ulong,im As Any Ptr)
    Dim As Double pi=4*Atn(1),start=pi/10
    Var count=0,rad=0.0,px=0.0,py=0.0
    For z As Single=start To 2*pi+.01+start Step 2*pi/10
        count=count+1
        If count Mod 2=0 Then rad=size Else rad=.4*size
        px=cx+rad*Cos(z)
        py=cy+rad*Sin(z)
        If count=1 Then Pset im,(px,py)Else Line im,-(px,py),col
    Next z
    Paint im,(cx,cy),col,col
End Sub

'=================  =============
Dim As String history(1 To 10)

Screen 20,32
'first rectangle (a square)
Dim As double side1=400
Dim As double side2=400
Dim As Any Ptr i=Imagecreate(side1,side2,Rgb(0,100,255))
'draw a shape to i
pentagon(200,220,190,Rgb(200,0,0),i)
Put(30,40),i
Draw String(0,0),"Rect Area = " &(side1*side2)
Dim As Long area=getshapearea(i)
Draw String(0,20),"Shape Area = " &area
updatehistory(history(),Str(Area))
showhistory(history(),23,70)
print "press a key"
Sleep
Dim As double k
Do
    Cls
    Do
        k=Rnd
    Loop Until k>.5
    'Albert's change
    dim as double newside1=side1*k
    dim as double newside2=side2/k
    If Rnd>.5 Then Swap newside1,newside2
    dim as any ptr i2=resize(i,newside1,newside2)
    Put(20,40),i2
   
    Draw String(0,0),"Rect Area = " &(newside1*newside2)
    Area=getshapearea(i2)
    Draw String(0,20),"Shape Area = " &area
    updatehistory(history(),Str(Area))
    showhistory(history(),23,70)
   
    Sleep
    imagedestroy i2
Loop Until Inkey=Chr(27)
imagedestroy i

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

Re: Squares

Postby albert » Jul 17, 2018 22:50

I'm working on manipulating the two sides x , y

adding doesn't work!!
If you add 1 to one side and subtract 1 from the other side , it doesn't work..

It should be the worlds fastest multiplier.. If i get it working , i'm gonna call it the Nobel Multiplier.

(!!~~OFF TOPIC~~!!)
I wrote a new song
chorus = "do you got a hole for me nuts" and "She ate me nuts fast"

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

Re: Squares

Postby albert » Jul 20, 2018 18:48

I got it working with added and subtracted values!!

what ever you add to one side , you have to subtract from the other side
Then you have to square the value added and subtracted , and add it to the n1*n2 :

answer = ( n1 * n2 ) + ( added * added )

Press space to stop scrolling
Press space to stop ten press esc to exit


Code: Select all


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

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

Declare Function half(fl As String) As String

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

screen 19

do
   
    randomize
    dim as string num1
    for a as longint =  1 to 2 step 1
        num1+=str(int(rnd*10))
    next
    if left(num1,1) = "0" then mid(num1,1,1)=str(int(rnd*9)+1)
   
    dim as double time1
    dim as double time2
    dim as double time3
    dim as double time4
   
    time1 = timer
    '===============================================================================
       
        dim as double n1 = val(num1)
        dim as double n2 = val(num1)
       
        dim as double add
        do
            if n1 mod 100 = 0 then exit do
            n1+=1
            n2-=1
            add+=1
        loop until n1 mod 100 = 0 or n2 <= 2
       
        dim as longint answer = (n1*n2) + (add*add)   'add the squared multiplied added and subtracted value
       
        print n1
        print n2
        print answer
       
        dim as string my_answer = str(answer)
   
    '===============================================================================
    time2 = timer
   
    time3 = timer
        dim as string mul_answer = multiplier_7( num1,num1)
        mul_answer = left(mul_answer,len(mul_answer)-1)
    time4 = timer
   
    dim as string difference = minus( mul_answer , my_answer )
   
    print
    locate ,1  : print "num1    = " ; num1
    'locate ,1  : print "num2    = " ; num2
    locate ,1  : print "n1 * n2 = " ; mul_answer
    locate ,1  : print "answer  = " ; my_answer
   
    print
    locate ,1  : print "difference = " ; difference
    print
   
    locate ,1  : print "new mul time =  " ; time2-time1
    locate ,1  : print "old mul time =  " ; time4-time3
   
    if difference <> "0" then sleep
   
    if inkey = " " then sleep
    if inkey = chr(27) then sleep : end
   
loop until inkey = chr(27)
'===============================================================================
sleep
end
'==================================================
'==================================================
Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As String
          Dim As String number=n1,divisor=n2
          dpflag=lcase(dpflag)
          'For MOD
          dim as integer modstop
          if dpflag="mod" then
              if len(n1)<len(n2) then return n1
              if len(n1)=len(n2) then
                  if n1<n2 then return n1
                  end if
              modstop=len(n1)-len(n2)+1
              end if
          if dpflag<>"mod" then
     If dpflag<>"s"  Then dpflag="raw"
     end if
        Dim runcount As integer
        '_______  LOOK UP TABLES ______________
        Dim Qmod(0 To 19) As Ubyte
        Dim bool(0 To 19) As Ubyte
        For z As Integer=0 To 19
    Qmod(z)=(z Mod 10+48)
    bool(z)=(-(10>z))
Next z
Dim answer As String   'THE ANSWER STRING 

'_______ SET THE DECIMAL WHERE IT SHOULD BE AT _______
Dim As String part1,part2
#macro set(decimal)
#macro insert(s,char,position)
If position > 0 And position <=Len(s) Then
part1=Mid$(s,1,position-1)
part2=Mid$(s,position)
s=part1+char+part2
End if
#endmacro
insert(answer,".",decpos)
  answer=thepoint+zeros+answer
If dpflag="raw" Then
    answer=Mid(answer,1,decimal_places)
    End if
#endmacro
'______________________________________________
'__________ SPLIT A STRING ABOUT A CHARACTRR __________
Dim As String var1,var2
    Dim pst As integer
      #macro split(stri,char,var1,var2)
    pst=Instr(stri,char)
    var1="":var2=""
    If pst<>0 Then
    var1=Rtrim(Mid(stri,1,pst),".")
    var2=Ltrim(Mid(stri,pst),".")
Else
    var1=stri
    End if
    #endmacro
   
       #macro Removepoint(s)
       split(s,".",var1,var2)
#endmacro
'__________ GET THE SIGN AND CLEAR THE -ve __________________
Dim sign As String
          If Left(number,1)="-" Xor Left (divisor,1)="-" Then sign="-"
            If Left(number,1)="-" Then  number=Ltrim(number,"-")
            If Left (divisor,1)="-" Then divisor=Ltrim(divisor,"-")
             
'DETERMINE THE DECIMAL POSITION BEFORE THE DIVISION
Dim As integer lennint,lenddec,lend,lenn,difflen
split(number,".",var1,var2)
lennint=Len(var1)
split(divisor,".",var1,var2)
lenddec=Len(var2)

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

Else
decimal_places=decimal_places+decpos
runlength=decimal_places
answer=String(Len(zeros)+runlength+10,"0")
End if
'___________DECIMAL POSITION DETERMINED  _____________

'SET UP THE VARIABLES AND START UP CONDITIONS
number=number+String(difflen+decimal_places,"0")
        Dim count As integer
        Dim temp As String
        Dim copytemp As String
        Dim topstring As String
        Dim copytopstring As String
        Dim As integer lenf,lens
        Dim As Ubyte takeaway,subtractcarry
        Dim As integer n3,diff
       If Ltrim(divisor,"0")="" Then Return "Error :division by zero"   
        lens=Len(divisor)
         topstring=Left(number,lend)
         copytopstring=topstring
        Do
            count=0
        Do
            count=count+1
            copytemp=temp
   
            Do
'___________________ QUICK SUBTRACTION loop _________________             
           
lenf=Len(topstring)
If  lens<lenf=0 Then 'not
If Lens>lenf Then
temp= "done"
Exit Do
End if
If divisor>topstring Then
temp= "done"
Exit Do
End if
End if

  diff=lenf-lens
        temp=topstring
        subtractcarry=0
       
        For n3=lenf-1 To diff Step -1
            takeaway= topstring[n3]-divisor[n3-diff]+10-subtractcarry
            temp[n3]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
        Next n3
        If subtractcarry=0 Then Exit Do
         If n3=-1 Then Exit Do
        For n3=n3 To 0 Step -1
            takeaway= topstring[n3]-38-subtractcarry
             temp[n3]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
            if subtractcarry=0 then exit do
            Next n3
        Exit Do
       
        Loop 'single run
        temp=Ltrim(temp,"0")
        If temp="" Then temp= "0"
            topstring=temp
        Loop Until temp="done"
     ' INDIVIDUAL CHARACTERS CARVED OFF ________________       
        runcount=runcount+1
       If count=1 Then
           topstring=copytopstring+Mid(number,lend+runcount,1)
           Else
       topstring=copytemp+Mid(number,lend+runcount,1)
   End If
       copytopstring=topstring
       topstring=Ltrim(topstring,"0")
       if dpflag="mod" then
       if runcount=modstop then
           if topstring="" then return "0"
           return mid(topstring,1,len(topstring)-1)
           end if
       end if
       answer[runcount-1]=count+47
       If topstring="" And runcount>Len(n1)+1 Then
           Exit Do
           End if
   Loop Until runcount=runlength+1
   
   ' END OF RUN TO REQUIRED DECIMAL PLACES
   set(decimal) 'PUT IN THE DECIMAL POINT
  'THERE IS ALWAYS A DECIMAL POINT SOMEWHERE IN THE ANSWER
  'NOW GET RID OF IT IF IT IS REDUNDANT
       answer=Rtrim(answer,"0")
       answer=Rtrim(answer,".")
       answer=Ltrim(answer,"0")
       If answer="" Then Return "0"
   Return sign+answer
End Function
'===============================================================================
'===============================================================================
Function half(fl As String) As String
    Dim As Ubyte main,carry,temp
    Dim As String sign   , s
    If Instr(fl,".")=0 Then s=fl+".0" Else s=fl+"0"
    If Instr(s,"-") Then sign="-":s=Ltrim(s,"-")
    Dim As String ans=s
    For z As Integer=0 To Len(s)-1
        If s[z]<>46 Then
            temp=(s[z]-48+carry)
            main=temp Shr 1
            carry=(temp And 1) Shl 3 +(temp And 1) Shl 1
            ans[z]=main+48
        End If
    Next z
    If Instr(ans,".") Then ans=Rtrim(ans,"0")
    ans=Rtrim(ans,".")
    ans=Ltrim(ans,"0")
    Return ans
End Function
'===============================================================================
'===============================================================================
'Dodicats plus & Minus functions
'===============================================================================
'===============================================================================
    Function plus(_num1 As String,_num2 As String) As String
        Dim  ADDQmod(0 To 19) As Ubyte
        Dim  ADDbool(0 To 19) As Ubyte
        For z As Integer=0 To 19
            ADDQmod(z)=(z Mod 10+48)
            ADDbool(z)=(-(10<=z))
        Next z
        Var _flag=0,n_=0
        Dim As Ubyte addup=Any,addcarry=Any
        #macro finish()
        answer=Ltrim(answer,"0")
        If _flag=1 Then Swap _num2,_num1
        Return answer
        #endmacro
        If Len(_num2)>Len(_num1) Then
            Swap _num2,_num1
            _flag=1
        End If
        Var diff=Len(_num1)-Len(_num2)
        Var answer="0"+_num1
        addcarry=0
        For n_=Len(_num1)-1 To diff Step -1
            addup=_num2[n_-diff]+_num1[n_]-96
            answer[n_+1]=ADDQmod(addup+addcarry)
            addcarry=ADDbool(addup+addcarry)
        Next n_
        If addcarry=0 Then
            finish()
        End If
        If n_=-1 Then
            answer[0]=addcarry+48
            finish()
            Endif
            For n_=n_ To 0 Step -1
                addup=_num1[n_]-48
                answer[n_+1]=ADDQmod(addup+addcarry)
                addcarry=ADDbool(addup+addcarry)
                If addcarry=0 Then Exit For
            Next n_
            answer[0]=addcarry+48
            finish()
        End Function
'===============================================================================
'===============================================================================
Function minus(NUM1 As String,NUM2 As String) As String
     'Dim As String copyfirstnum=mul_num_1,copysecondnum=mul_num_2
    Dim As Byte swapflag           
    Dim As Long lenf,lens
    Dim sign As String * 1
    'Dim As String part1,part2
    Dim bigger As Byte
     'set up tables
    Dim As Ubyte Qmod(0 To 19)
    Dim bool(0 To 19) As Ubyte

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

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

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

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

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

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

    return outtext

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

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

Re: Squares

Postby Richard » Jul 20, 2018 23:25

Albert wrote: I got it working with added and subtracted values!!
what ever you add to one side , you have to subtract from the other side
Then you have to square the value added and subtracted , and add it to the n1*n2 :
answer = ( n1 * n2 ) + ( added * added )

That works for squares when n1 = n2, but what about when n1 <> n2 ?
Should it then something more like; answer = ( n1 * n2 ) + ( added * ( added + n1 – n2 ) ) ?
albert
Posts: 5247
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jul 21, 2018 18:30

@Richard

It doesn't work, the added value you have to square is as big as the number.. so you might just as well multiply the two numbers.
albert
Posts: 5247
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jul 23, 2018 3:00

@Richard

I got it working with the two number being different...

dim as double n1 = val( "1" + string(len(num1),"0") )
dim as double n2 = val(num2) / (n1 / val(num1) )

dim as ulongint answer = ( n1 * n2 )


Code: Select all


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

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

Declare Function half(fl As String) As String

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

screen 19

do
   
    randomize
   
    dim as string num1
    for a as longint =  1 to 2 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 2 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 swap num1,num2
    if len(num2) = len(num1) then if val(left(num2,1)) > val(left(num1,1)) then swap num1,num2
       
    dim as double time1
    dim as double time2
    dim as double time3
    dim as double time4
   
    time1 = timer
    '===============================================================================
       
        dim as double n1 = val( "1" + string(len(num1),"0") )
        dim as double n2 = val(num2) /  (n1 / val(num1) )
       
        dim as ulongint answer = ( n1 * n2 )
       
        print n1
        print n2
        'print add
        print answer
       
        dim as string my_answer = str(answer)
   
    '===============================================================================
    time2 = timer
   
    time3 = timer
        dim as string mul_answer = multiplier_7( num1,num2)
        mul_answer = left(mul_answer,len(mul_answer)-1)
    time4 = timer
   
    dim as string difference = minus( mul_answer , my_answer )
   
    print
    locate ,1  : print "num1    = " ; num1
    locate ,1  : print "num2    = " ; num2
    locate ,1  : print "n1 * n2 = " ; mul_answer
    locate ,1  : print "answer  = " ; my_answer
   
    print
    locate ,1  : print "difference = " ; difference
    print
   
    locate ,1  : print "new mul time =  " ; time2-time1
    locate ,1  : print "old mul time =  " ; time4-time3
   
    if difference <> "0" then sleep
   
    if inkey = " " then sleep
    if inkey = chr(27) then sleep : end
   
loop until inkey = chr(27)
'===============================================================================
sleep
end
'==================================================
'==================================================
Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As String
          Dim As String number=n1,divisor=n2
          dpflag=lcase(dpflag)
          'For MOD
          dim as integer modstop
          if dpflag="mod" then
              if len(n1)<len(n2) then return n1
              if len(n1)=len(n2) then
                  if n1<n2 then return n1
                  end if
              modstop=len(n1)-len(n2)+1
              end if
          if dpflag<>"mod" then
     If dpflag<>"s"  Then dpflag="raw"
     end if
        Dim runcount As integer
        '_______  LOOK UP TABLES ______________
        Dim Qmod(0 To 19) As Ubyte
        Dim bool(0 To 19) As Ubyte
        For z As Integer=0 To 19
    Qmod(z)=(z Mod 10+48)
    bool(z)=(-(10>z))
Next z
Dim answer As String   'THE ANSWER STRING 

'_______ SET THE DECIMAL WHERE IT SHOULD BE AT _______
Dim As String part1,part2
#macro set(decimal)
#macro insert(s,char,position)
If position > 0 And position <=Len(s) Then
part1=Mid$(s,1,position-1)
part2=Mid$(s,position)
s=part1+char+part2
End if
#endmacro
insert(answer,".",decpos)
  answer=thepoint+zeros+answer
If dpflag="raw" Then
    answer=Mid(answer,1,decimal_places)
    End if
#endmacro
'______________________________________________
'__________ SPLIT A STRING ABOUT A CHARACTRR __________
Dim As String var1,var2
    Dim pst As integer
      #macro split(stri,char,var1,var2)
    pst=Instr(stri,char)
    var1="":var2=""
    If pst<>0 Then
    var1=Rtrim(Mid(stri,1,pst),".")
    var2=Ltrim(Mid(stri,pst),".")
Else
    var1=stri
    End if
    #endmacro
   
       #macro Removepoint(s)
       split(s,".",var1,var2)
#endmacro
'__________ GET THE SIGN AND CLEAR THE -ve __________________
Dim sign As String
          If Left(number,1)="-" Xor Left (divisor,1)="-" Then sign="-"
            If Left(number,1)="-" Then  number=Ltrim(number,"-")
            If Left (divisor,1)="-" Then divisor=Ltrim(divisor,"-")
             
'DETERMINE THE DECIMAL POSITION BEFORE THE DIVISION
Dim As integer lennint,lenddec,lend,lenn,difflen
split(number,".",var1,var2)
lennint=Len(var1)
split(divisor,".",var1,var2)
lenddec=Len(var2)

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

Else
decimal_places=decimal_places+decpos
runlength=decimal_places
answer=String(Len(zeros)+runlength+10,"0")
End if
'___________DECIMAL POSITION DETERMINED  _____________

'SET UP THE VARIABLES AND START UP CONDITIONS
number=number+String(difflen+decimal_places,"0")
        Dim count As integer
        Dim temp As String
        Dim copytemp As String
        Dim topstring As String
        Dim copytopstring As String
        Dim As integer lenf,lens
        Dim As Ubyte takeaway,subtractcarry
        Dim As integer n3,diff
       If Ltrim(divisor,"0")="" Then Return "Error :division by zero"   
        lens=Len(divisor)
         topstring=Left(number,lend)
         copytopstring=topstring
        Do
            count=0
        Do
            count=count+1
            copytemp=temp
   
            Do
'___________________ QUICK SUBTRACTION loop _________________             
           
lenf=Len(topstring)
If  lens<lenf=0 Then 'not
If Lens>lenf Then
temp= "done"
Exit Do
End if
If divisor>topstring Then
temp= "done"
Exit Do
End if
End if

  diff=lenf-lens
        temp=topstring
        subtractcarry=0
       
        For n3=lenf-1 To diff Step -1
            takeaway= topstring[n3]-divisor[n3-diff]+10-subtractcarry
            temp[n3]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
        Next n3
        If subtractcarry=0 Then Exit Do
         If n3=-1 Then Exit Do
        For n3=n3 To 0 Step -1
            takeaway= topstring[n3]-38-subtractcarry
             temp[n3]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
            if subtractcarry=0 then exit do
            Next n3
        Exit Do
       
        Loop 'single run
        temp=Ltrim(temp,"0")
        If temp="" Then temp= "0"
            topstring=temp
        Loop Until temp="done"
     ' INDIVIDUAL CHARACTERS CARVED OFF ________________       
        runcount=runcount+1
       If count=1 Then
           topstring=copytopstring+Mid(number,lend+runcount,1)
           Else
       topstring=copytemp+Mid(number,lend+runcount,1)
   End If
       copytopstring=topstring
       topstring=Ltrim(topstring,"0")
       if dpflag="mod" then
       if runcount=modstop then
           if topstring="" then return "0"
           return mid(topstring,1,len(topstring)-1)
           end if
       end if
       answer[runcount-1]=count+47
       If topstring="" And runcount>Len(n1)+1 Then
           Exit Do
           End if
   Loop Until runcount=runlength+1
   
   ' END OF RUN TO REQUIRED DECIMAL PLACES
   set(decimal) 'PUT IN THE DECIMAL POINT
  'THERE IS ALWAYS A DECIMAL POINT SOMEWHERE IN THE ANSWER
  'NOW GET RID OF IT IF IT IS REDUNDANT
       answer=Rtrim(answer,"0")
       answer=Rtrim(answer,".")
       answer=Ltrim(answer,"0")
       If answer="" Then Return "0"
   Return sign+answer
End Function
'===============================================================================
'===============================================================================
Function half(fl As String) As String
    Dim As Ubyte main,carry,temp
    Dim As String sign   , s
    If Instr(fl,".")=0 Then s=fl+".0" Else s=fl+"0"
    If Instr(s,"-") Then sign="-":s=Ltrim(s,"-")
    Dim As String ans=s
    For z As Integer=0 To Len(s)-1
        If s[z]<>46 Then
            temp=(s[z]-48+carry)
            main=temp Shr 1
            carry=(temp And 1) Shl 3 +(temp And 1) Shl 1
            ans[z]=main+48
        End If
    Next z
    If Instr(ans,".") Then ans=Rtrim(ans,"0")
    ans=Rtrim(ans,".")
    ans=Ltrim(ans,"0")
    Return ans
End Function
'===============================================================================
'===============================================================================
'Dodicats plus & Minus functions
'===============================================================================
'===============================================================================
    Function plus(_num1 As String,_num2 As String) As String
        Dim  ADDQmod(0 To 19) As Ubyte
        Dim  ADDbool(0 To 19) As Ubyte
        For z As Integer=0 To 19
            ADDQmod(z)=(z Mod 10+48)
            ADDbool(z)=(-(10<=z))
        Next z
        Var _flag=0,n_=0
        Dim As Ubyte addup=Any,addcarry=Any
        #macro finish()
        answer=Ltrim(answer,"0")
        If _flag=1 Then Swap _num2,_num1
        Return answer
        #endmacro
        If Len(_num2)>Len(_num1) Then
            Swap _num2,_num1
            _flag=1
        End If
        Var diff=Len(_num1)-Len(_num2)
        Var answer="0"+_num1
        addcarry=0
        For n_=Len(_num1)-1 To diff Step -1
            addup=_num2[n_-diff]+_num1[n_]-96
            answer[n_+1]=ADDQmod(addup+addcarry)
            addcarry=ADDbool(addup+addcarry)
        Next n_
        If addcarry=0 Then
            finish()
        End If
        If n_=-1 Then
            answer[0]=addcarry+48
            finish()
            Endif
            For n_=n_ To 0 Step -1
                addup=_num1[n_]-48
                answer[n_+1]=ADDQmod(addup+addcarry)
                addcarry=ADDbool(addup+addcarry)
                If addcarry=0 Then Exit For
            Next n_
            answer[0]=addcarry+48
            finish()
        End Function
'===============================================================================
'===============================================================================
Function minus(NUM1 As String,NUM2 As String) As String
     'Dim As String copyfirstnum=mul_num_1,copysecondnum=mul_num_2
    Dim As Byte swapflag           
    Dim As Long lenf,lens
    Dim sign As String * 1
    'Dim As String part1,part2
    Dim bigger As Byte
     'set up tables
    Dim As Ubyte Qmod(0 To 19)
    Dim bool(0 To 19) As Ubyte

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

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

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

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

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

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

    return outtext

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

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

Re: Squares

Postby albert » Jul 23, 2018 17:32

Hi Guys!!

I got it working with strings and Dodicat's divider.
Here it is multiplying 100 x100 digits.. it's several hundred times slower..

Code: Select all



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

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

Declare Function half(fl As String) As String

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

screen 19

do
   
    randomize
   
    dim as string num1
    for a as longint =  1 to 100 step 1
        num1+=str(int(rnd*10))
    next
    if left(num1,1) = "0" then mid(num1,1,1)=str(int(rnd*9)+1)
   
    dim as string num2
    for a as longint =  1 to 100 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 swap num1,num2
    if len(num2) = len(num1) then if val(left(num2,1)) > val(left(num1,1)) then swap num1,num2
       
    dim as double time1
    dim as double time2
    dim as double time3
    dim as double time4
   
    time1 = timer
    '===============================================================================
       
        dim as string n1 = "1" + string(len(num1),"0")
        'dim as double n2 = val(num2) /  (n1 / val(num1) )
       
        dim as string div = divide( n1 , num1 , len(num1) + len(num2) )
        dim as string n2 = divide( num2 , div , len(num1) + len(num2) )
       
        dim as string answer = n2 + mid( n1 , 2 )
       
        dim as longint dec1 = instr( answer , "." )
        answer = left( answer , dec1-1 ) + mid( answer , dec1+1 , len(n1)-1 )
       
        print n1
        print n2
        print answer
       
        dim as string my_answer = answer
   
    '===============================================================================
    time2 = timer
   
    time3 = timer
        dim as string mul_answer = multiplier_7( num1,num2)
        mul_answer = left(mul_answer,len(mul_answer)-1)
    time4 = timer
   
    dim as string difference = minus( mul_answer , my_answer )
   
    print
    locate ,1  : print "num1    = " ; num1
    locate ,1  : print "num2    = " ; num2
    locate ,1  : print "n1 * n2 = " ; mul_answer
    locate ,1  : print "answer  = " ; my_answer
   
    print
    locate ,1  : print "difference = " ; difference
    print
   
    locate ,1  : print "new mul time =  " ; time2-time1
    locate ,1  : print "old mul time =  " ; time4-time3
   
    if difference <> "0" then sleep
   
    if inkey = " " then sleep
    if inkey = chr(27) then sleep : end
   
loop until inkey = chr(27)
'===============================================================================
sleep
end
'==================================================
'==================================================
Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As String
          Dim As String number=n1,divisor=n2
          dpflag=lcase(dpflag)
          'For MOD
          dim as integer modstop
          if dpflag="mod" then
              if len(n1)<len(n2) then return n1
              if len(n1)=len(n2) then
                  if n1<n2 then return n1
                  end if
              modstop=len(n1)-len(n2)+1
              end if
          if dpflag<>"mod" then
     If dpflag<>"s"  Then dpflag="raw"
     end if
        Dim runcount As integer
        '_______  LOOK UP TABLES ______________
        Dim Qmod(0 To 19) As Ubyte
        Dim bool(0 To 19) As Ubyte
        For z As Integer=0 To 19
    Qmod(z)=(z Mod 10+48)
    bool(z)=(-(10>z))
Next z
Dim answer As String   'THE ANSWER STRING 

'_______ SET THE DECIMAL WHERE IT SHOULD BE AT _______
Dim As String part1,part2
#macro set(decimal)
#macro insert(s,char,position)
If position > 0 And position <=Len(s) Then
part1=Mid$(s,1,position-1)
part2=Mid$(s,position)
s=part1+char+part2
End if
#endmacro
insert(answer,".",decpos)
  answer=thepoint+zeros+answer
If dpflag="raw" Then
    answer=Mid(answer,1,decimal_places)
    End if
#endmacro
'______________________________________________
'__________ SPLIT A STRING ABOUT A CHARACTRR __________
Dim As String var1,var2
    Dim pst As integer
      #macro split(stri,char,var1,var2)
    pst=Instr(stri,char)
    var1="":var2=""
    If pst<>0 Then
    var1=Rtrim(Mid(stri,1,pst),".")
    var2=Ltrim(Mid(stri,pst),".")
Else
    var1=stri
    End if
    #endmacro
   
       #macro Removepoint(s)
       split(s,".",var1,var2)
#endmacro
'__________ GET THE SIGN AND CLEAR THE -ve __________________
Dim sign As String
          If Left(number,1)="-" Xor Left (divisor,1)="-" Then sign="-"
            If Left(number,1)="-" Then  number=Ltrim(number,"-")
            If Left (divisor,1)="-" Then divisor=Ltrim(divisor,"-")
             
'DETERMINE THE DECIMAL POSITION BEFORE THE DIVISION
Dim As integer lennint,lenddec,lend,lenn,difflen
split(number,".",var1,var2)
lennint=Len(var1)
split(divisor,".",var1,var2)
lenddec=Len(var2)

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

Else
decimal_places=decimal_places+decpos
runlength=decimal_places
answer=String(Len(zeros)+runlength+10,"0")
End if
'___________DECIMAL POSITION DETERMINED  _____________

'SET UP THE VARIABLES AND START UP CONDITIONS
number=number+String(difflen+decimal_places,"0")
        Dim count As integer
        Dim temp As String
        Dim copytemp As String
        Dim topstring As String
        Dim copytopstring As String
        Dim As integer lenf,lens
        Dim As Ubyte takeaway,subtractcarry
        Dim As integer n3,diff
       If Ltrim(divisor,"0")="" Then Return "Error :division by zero"   
        lens=Len(divisor)
         topstring=Left(number,lend)
         copytopstring=topstring
        Do
            count=0
        Do
            count=count+1
            copytemp=temp
   
            Do
'___________________ QUICK SUBTRACTION loop _________________             
           
lenf=Len(topstring)
If  lens<lenf=0 Then 'not
If Lens>lenf Then
temp= "done"
Exit Do
End if
If divisor>topstring Then
temp= "done"
Exit Do
End if
End if

  diff=lenf-lens
        temp=topstring
        subtractcarry=0
       
        For n3=lenf-1 To diff Step -1
            takeaway= topstring[n3]-divisor[n3-diff]+10-subtractcarry
            temp[n3]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
        Next n3
        If subtractcarry=0 Then Exit Do
         If n3=-1 Then Exit Do
        For n3=n3 To 0 Step -1
            takeaway= topstring[n3]-38-subtractcarry
             temp[n3]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
            if subtractcarry=0 then exit do
            Next n3
        Exit Do
       
        Loop 'single run
        temp=Ltrim(temp,"0")
        If temp="" Then temp= "0"
            topstring=temp
        Loop Until temp="done"
     ' INDIVIDUAL CHARACTERS CARVED OFF ________________       
        runcount=runcount+1
       If count=1 Then
           topstring=copytopstring+Mid(number,lend+runcount,1)
           Else
       topstring=copytemp+Mid(number,lend+runcount,1)
   End If
       copytopstring=topstring
       topstring=Ltrim(topstring,"0")
       if dpflag="mod" then
       if runcount=modstop then
           if topstring="" then return "0"
           return mid(topstring,1,len(topstring)-1)
           end if
       end if
       answer[runcount-1]=count+47
       If topstring="" And runcount>Len(n1)+1 Then
           Exit Do
           End if
   Loop Until runcount=runlength+1
   
   ' END OF RUN TO REQUIRED DECIMAL PLACES
   set(decimal) 'PUT IN THE DECIMAL POINT
  'THERE IS ALWAYS A DECIMAL POINT SOMEWHERE IN THE ANSWER
  'NOW GET RID OF IT IF IT IS REDUNDANT
       answer=Rtrim(answer,"0")
       answer=Rtrim(answer,".")
       answer=Ltrim(answer,"0")
       If answer="" Then Return "0"
   Return sign+answer
End Function
'===============================================================================
'===============================================================================
Function half(fl As String) As String
    Dim As Ubyte main,carry,temp
    Dim As String sign   , s
    If Instr(fl,".")=0 Then s=fl+".0" Else s=fl+"0"
    If Instr(s,"-") Then sign="-":s=Ltrim(s,"-")
    Dim As String ans=s
    For z As Integer=0 To Len(s)-1
        If s[z]<>46 Then
            temp=(s[z]-48+carry)
            main=temp Shr 1
            carry=(temp And 1) Shl 3 +(temp And 1) Shl 1
            ans[z]=main+48
        End If
    Next z
    If Instr(ans,".") Then ans=Rtrim(ans,"0")
    ans=Rtrim(ans,".")
    ans=Ltrim(ans,"0")
    Return ans
End Function
'===============================================================================
'===============================================================================
'Dodicats plus & Minus functions
'===============================================================================
'===============================================================================
    Function plus(_num1 As String,_num2 As String) As String
        Dim  ADDQmod(0 To 19) As Ubyte
        Dim  ADDbool(0 To 19) As Ubyte
        For z As Integer=0 To 19
            ADDQmod(z)=(z Mod 10+48)
            ADDbool(z)=(-(10<=z))
        Next z
        Var _flag=0,n_=0
        Dim As Ubyte addup=Any,addcarry=Any
        #macro finish()
        answer=Ltrim(answer,"0")
        If _flag=1 Then Swap _num2,_num1
        Return answer
        #endmacro
        If Len(_num2)>Len(_num1) Then
            Swap _num2,_num1
            _flag=1
        End If
        Var diff=Len(_num1)-Len(_num2)
        Var answer="0"+_num1
        addcarry=0
        For n_=Len(_num1)-1 To diff Step -1
            addup=_num2[n_-diff]+_num1[n_]-96
            answer[n_+1]=ADDQmod(addup+addcarry)
            addcarry=ADDbool(addup+addcarry)
        Next n_
        If addcarry=0 Then
            finish()
        End If
        If n_=-1 Then
            answer[0]=addcarry+48
            finish()
            Endif
            For n_=n_ To 0 Step -1
                addup=_num1[n_]-48
                answer[n_+1]=ADDQmod(addup+addcarry)
                addcarry=ADDbool(addup+addcarry)
                If addcarry=0 Then Exit For
            Next n_
            answer[0]=addcarry+48
            finish()
        End Function
'===============================================================================
'===============================================================================
Function minus(NUM1 As String,NUM2 As String) As String
     'Dim As String copyfirstnum=mul_num_1,copysecondnum=mul_num_2
    Dim As Byte swapflag           
    Dim As Long lenf,lens
    Dim sign As String * 1
    'Dim As String part1,part2
    Dim bigger As Byte
     'set up tables
    Dim As Ubyte Qmod(0 To 19)
    Dim bool(0 To 19) As Ubyte

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

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

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

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

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

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

    return outtext

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

Last edited by albert on Jul 24, 2018 22:33, edited 1 time in total.
albert
Posts: 5247
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jul 24, 2018 17:10

I decided to work on a faster divider...

Heres my first attempt..
I got to make it to work with strings yet..

@Dodicat
Can you make your 1-9 divider in reverse , where you divide 1 to 9 by a value , instead of dividing a value by 1 to 9?

Code: Select all


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

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

Declare Function half(fl As String) As String

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

screen 19

do
   
    randomize
   
    dim as string num1
    for a as longint =  1 to 10 step 1
        num1+=str(int(rnd*10))
    next
    if left(num1,1) = "0" then mid(num1,1,1)=str(int(rnd*9)+1)
   
    dim as string num2
    for a as longint =  1 to 10 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 swap num1,num2
    if len(num2) = len(num1) then if val(left(num2,1)) > val(left(num1,1)) then swap num1,num2
       
    dim as double time1
    dim as double time2
    dim as double time3
    dim as double time4
   
    time1 = timer
    '===============================================================================
       
        dim as double answer = 0
        dim as string n1 = num1
        dim as string n2 = num2
        dim as ulongint value = 0
        for a as longint = 1 to len(num1) step 1
            value = val(mid(num1,a,1))
            answer+= value / val(n2)
            answer*=10
        next
        answer/=10
       
        print n1
        print n2
        print answer
       
        dim as string my_answer = left( str(answer) , len(num1)+len(num2)+1 )
        if left( my_answer, 1) = "0" then my_answer = mid(my_answer,2)
       
    '===============================================================================
    time2 = timer
   
    time3 = timer
        dim as string div_answer = divide( num1,num2, len(num1)+len(num2)+1)
    time4 = timer
   
    dim as string difference = minus( div_answer , my_answer )
   
    print
    locate ,1  : print "num1    = " ; num1
    locate ,1  : print "num2    = " ; num2
    locate ,1  : print "n1 / n2 = " ; div_answer
    locate ,1  : print "answer  = " ; my_answer
   
    print
    locate ,1  : print "difference = " ; difference
    print
   
    locate ,1  : print "new mul time =  " ; time2-time1
    locate ,1  : print "old mul time =  " ; time4-time3
   
    if difference <> "0" then sleep
   
    if inkey = " " then sleep
    if inkey = chr(27) then sleep : end
   
loop until inkey = chr(27)
'===============================================================================
sleep
end
'==================================================
'==================================================
Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As String
          Dim As String number=n1,divisor=n2
          dpflag=lcase(dpflag)
          'For MOD
          dim as integer modstop
          if dpflag="mod" then
              if len(n1)<len(n2) then return n1
              if len(n1)=len(n2) then
                  if n1<n2 then return n1
                  end if
              modstop=len(n1)-len(n2)+1
              end if
          if dpflag<>"mod" then
     If dpflag<>"s"  Then dpflag="raw"
     end if
        Dim runcount As integer
        '_______  LOOK UP TABLES ______________
        Dim Qmod(0 To 19) As Ubyte
        Dim bool(0 To 19) As Ubyte
        For z As Integer=0 To 19
    Qmod(z)=(z Mod 10+48)
    bool(z)=(-(10>z))
Next z
Dim answer As String   'THE ANSWER STRING 

'_______ SET THE DECIMAL WHERE IT SHOULD BE AT _______
Dim As String part1,part2
#macro set(decimal)
#macro insert(s,char,position)
If position > 0 And position <=Len(s) Then
part1=Mid$(s,1,position-1)
part2=Mid$(s,position)
s=part1+char+part2
End if
#endmacro
insert(answer,".",decpos)
  answer=thepoint+zeros+answer
If dpflag="raw" Then
    answer=Mid(answer,1,decimal_places)
    End if
#endmacro
'______________________________________________
'__________ SPLIT A STRING ABOUT A CHARACTRR __________
Dim As String var1,var2
    Dim pst As integer
      #macro split(stri,char,var1,var2)
    pst=Instr(stri,char)
    var1="":var2=""
    If pst<>0 Then
    var1=Rtrim(Mid(stri,1,pst),".")
    var2=Ltrim(Mid(stri,pst),".")
Else
    var1=stri
    End if
    #endmacro
   
       #macro Removepoint(s)
       split(s,".",var1,var2)
#endmacro
'__________ GET THE SIGN AND CLEAR THE -ve __________________
Dim sign As String
          If Left(number,1)="-" Xor Left (divisor,1)="-" Then sign="-"
            If Left(number,1)="-" Then  number=Ltrim(number,"-")
            If Left (divisor,1)="-" Then divisor=Ltrim(divisor,"-")
             
'DETERMINE THE DECIMAL POSITION BEFORE THE DIVISION
Dim As integer lennint,lenddec,lend,lenn,difflen
split(number,".",var1,var2)
lennint=Len(var1)
split(divisor,".",var1,var2)
lenddec=Len(var2)

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

Else
decimal_places=decimal_places+decpos
runlength=decimal_places
answer=String(Len(zeros)+runlength+10,"0")
End if
'___________DECIMAL POSITION DETERMINED  _____________

'SET UP THE VARIABLES AND START UP CONDITIONS
number=number+String(difflen+decimal_places,"0")
        Dim count As integer
        Dim temp As String
        Dim copytemp As String
        Dim topstring As String
        Dim copytopstring As String
        Dim As integer lenf,lens
        Dim As Ubyte takeaway,subtractcarry
        Dim As integer n3,diff
       If Ltrim(divisor,"0")="" Then Return "Error :division by zero"   
        lens=Len(divisor)
         topstring=Left(number,lend)
         copytopstring=topstring
        Do
            count=0
        Do
            count=count+1
            copytemp=temp
   
            Do
'___________________ QUICK SUBTRACTION loop _________________             
           
lenf=Len(topstring)
If  lens<lenf=0 Then 'not
If Lens>lenf Then
temp= "done"
Exit Do
End if
If divisor>topstring Then
temp= "done"
Exit Do
End if
End if

  diff=lenf-lens
        temp=topstring
        subtractcarry=0
       
        For n3=lenf-1 To diff Step -1
            takeaway= topstring[n3]-divisor[n3-diff]+10-subtractcarry
            temp[n3]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
        Next n3
        If subtractcarry=0 Then Exit Do
         If n3=-1 Then Exit Do
        For n3=n3 To 0 Step -1
            takeaway= topstring[n3]-38-subtractcarry
             temp[n3]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
            if subtractcarry=0 then exit do
            Next n3
        Exit Do
       
        Loop 'single run
        temp=Ltrim(temp,"0")
        If temp="" Then temp= "0"
            topstring=temp
        Loop Until temp="done"
     ' INDIVIDUAL CHARACTERS CARVED OFF ________________       
        runcount=runcount+1
       If count=1 Then
           topstring=copytopstring+Mid(number,lend+runcount,1)
           Else
       topstring=copytemp+Mid(number,lend+runcount,1)
   End If
       copytopstring=topstring
       topstring=Ltrim(topstring,"0")
       if dpflag="mod" then
       if runcount=modstop then
           if topstring="" then return "0"
           return mid(topstring,1,len(topstring)-1)
           end if
       end if
       answer[runcount-1]=count+47
       If topstring="" And runcount>Len(n1)+1 Then
           Exit Do
           End if
   Loop Until runcount=runlength+1
   
   ' END OF RUN TO REQUIRED DECIMAL PLACES
   set(decimal) 'PUT IN THE DECIMAL POINT
  'THERE IS ALWAYS A DECIMAL POINT SOMEWHERE IN THE ANSWER
  'NOW GET RID OF IT IF IT IS REDUNDANT
       answer=Rtrim(answer,"0")
       answer=Rtrim(answer,".")
       answer=Ltrim(answer,"0")
       If answer="" Then Return "0"
   Return sign+answer
End Function
'===============================================================================
'===============================================================================
Function half(fl As String) As String
    Dim As Ubyte main,carry,temp
    Dim As String sign   , s
    If Instr(fl,".")=0 Then s=fl+".0" Else s=fl+"0"
    If Instr(s,"-") Then sign="-":s=Ltrim(s,"-")
    Dim As String ans=s
    For z As Integer=0 To Len(s)-1
        If s[z]<>46 Then
            temp=(s[z]-48+carry)
            main=temp Shr 1
            carry=(temp And 1) Shl 3 +(temp And 1) Shl 1
            ans[z]=main+48
        End If
    Next z
    If Instr(ans,".") Then ans=Rtrim(ans,"0")
    ans=Rtrim(ans,".")
    ans=Ltrim(ans,"0")
    Return ans
End Function
'===============================================================================
'===============================================================================
'Dodicats plus & Minus functions
'===============================================================================
'===============================================================================
    Function plus(_num1 As String,_num2 As String) As String
        Dim  ADDQmod(0 To 19) As Ubyte
        Dim  ADDbool(0 To 19) As Ubyte
        For z As Integer=0 To 19
            ADDQmod(z)=(z Mod 10+48)
            ADDbool(z)=(-(10<=z))
        Next z
        Var _flag=0,n_=0
        Dim As Ubyte addup=Any,addcarry=Any
        #macro finish()
        answer=Ltrim(answer,"0")
        If _flag=1 Then Swap _num2,_num1
        Return answer
        #endmacro
        If Len(_num2)>Len(_num1) Then
            Swap _num2,_num1
            _flag=1
        End If
        Var diff=Len(_num1)-Len(_num2)
        Var answer="0"+_num1
        addcarry=0
        For n_=Len(_num1)-1 To diff Step -1
            addup=_num2[n_-diff]+_num1[n_]-96
            answer[n_+1]=ADDQmod(addup+addcarry)
            addcarry=ADDbool(addup+addcarry)
        Next n_
        If addcarry=0 Then
            finish()
        End If
        If n_=-1 Then
            answer[0]=addcarry+48
            finish()
            Endif
            For n_=n_ To 0 Step -1
                addup=_num1[n_]-48
                answer[n_+1]=ADDQmod(addup+addcarry)
                addcarry=ADDbool(addup+addcarry)
                If addcarry=0 Then Exit For
            Next n_
            answer[0]=addcarry+48
            finish()
        End Function
'===============================================================================
'===============================================================================
Function minus(NUM1 As String,NUM2 As String) As String
     'Dim As String copyfirstnum=mul_num_1,copysecondnum=mul_num_2
    Dim As Byte swapflag           
    Dim As Long lenf,lens
    Dim sign As String * 1
    'Dim As String part1,part2
    Dim bigger As Byte
     'set up tables
    Dim As Ubyte Qmod(0 To 19)
    Dim bool(0 To 19) As Ubyte

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

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

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

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

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

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

    return outtext

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


Return to “General”

Who is online

Users browsing this forum: No registered users and 1 guest