## Squares

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

### Re: Squares

@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

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

### Re: Squares

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 19do        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.."    sleeploop until inkey = chr(27)'===============================================================================sleepend`
albert
Posts: 5247
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@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 stringDECLARE Function minus(NUM1 As String,NUM2 As String) As StringDeclare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As Stringscreen 19do        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)'===============================================================================sleepend'==============================================================================='==============================================================================='Dodicats plus & Minus functions'==============================================================================='===============================================================================    Function plus(_num1 As String,_num2 As String) As String        Dim  ADDQmod(0 To 19) As Ubyte        Dim  ADDbool(0 To 19) As Ubyte        For z As Integer=0 To 19            ADDQmod(z)=(z Mod 10+48)            ADDbool(z)=(-(10<=z))        Next z        Var _flag=0,n_=0        Dim As Ubyte addup=Any,addcarry=Any        #macro finish()        answer=Ltrim(answer,"0")        If _flag=1 Then Swap _num2,_num1        Return answer        #endmacro        If Len(_num2)>Len(_num1) Then            Swap _num2,_num1            _flag=1        End If        Var diff=Len(_num1)-Len(_num2)        Var answer="0"+_num1        addcarry=0        For n_=Len(_num1)-1 To diff Step -1            addup=_num2[n_-diff]+_num1[n_]-96            answer[n_+1]=ADDQmod(addup+addcarry)            addcarry=ADDbool(addup+addcarry)        Next n_        If addcarry=0 Then            finish()        End If        If n_=-1 Then            answer=addcarry+48            finish()            Endif            For n_=n_ To 0 Step -1                addup=_num1[n_]-48                answer[n_+1]=ADDQmod(addup+addcarry)                addcarry=ADDbool(addup+addcarry)                If addcarry=0 Then Exit For            Next n_            answer=addcarry+48            finish()        End Function'==============================================================================='===============================================================================Function minus(NUM1 As String,NUM2 As String) As String     'Dim As String copyfirstnum=mul_num_1,copysecondnum=mul_num_2    Dim As Byte swapflag               Dim As Long lenf,lens    Dim sign As String * 1    'Dim As String part1,part2    Dim bigger As Byte     'set up tables    Dim As Ubyte Qmod(0 To 19)    Dim bool(0 To 19) As Ubyte    For z As Integer=0 To 19        Qmod(z)=cubyte(z Mod 10+48)        bool(z)=cubyte(-(10>z))    Next z    lenf=Len(NUM1)    lens=Len(NUM2)    #macro compare(numbers)        If Lens>lenf Then bigger= -1:Goto fin        If Lens<lenf Then bigger =0:Goto fin        If NUM2>NUM1 Then            bigger=-1        Else            bigger= 0        End If        fin:    #endmacro    compare(numbers)    If bigger Then        sign="-"        Swap NUM2,NUM1        Swap lens,lenf        swapflag=1    Endif    'lenf=Len(NUM1)    'lens=Len(NUM2)    Dim diff As Long=lenf-lens-Sgn(lenf-lens)    Dim As String one,two,three    three=NUM1    two=String(lenf-lens,"0")+NUM2    one=NUM1    Dim As Long n2    Dim As Ubyte takeaway,subtractcarry    Dim As Ubyte ten=10    'Dim z As Long    subtractcarry=0    Do         For n2=lenf-1 To diff Step -1           takeaway= one[n2]-two[n2]+ten-subtractcarry           three[n2]=Qmod(takeaway)            subtractcarry=bool(takeaway)        Next n2        If subtractcarry=0 Then Exit Do        If n2=-1 Then Exit Do        For n2=n2 To 0 Step -1            takeaway= one[n2]-two[n2]+ten-subtractcarry            three[n2]=Qmod(takeaway)            subtractcarry=bool(takeaway)            Next n2        Exit Do    Loop       three=Ltrim(three,"0")    If three="" Then Return "0"    If swapflag=1 Then Swap NUM1,NUM2       Return sign+three   End Function'==============================================================================='===============================================================================function multiplier_7(byref num1 as string, byref num2 as string) as string       dim as string number1,number2    dim as string answer,outtext       dim as string int1,frac1,int2,frac2    dim as ulongint dec,dec1,len1,len2    dim as string str1    dim as string sign1,sign2,outsign       number1 = num1    number2 = num2       sign1 = left(number1,1)    if sign1 = "+" or sign1 = "-" then number1 = mid(number1,2) else sign1 = ""       sign2 = left(number2,1)    if sign2 = "+" or sign2 = "-" then number2 = mid(number2,2) else sign2 = ""       if (sign1 = sign2) then outsign = ""    if (sign1 <> sign2) then outsign = "-"       dec = instr(1,number1,".")    if dec > 0 then        int1 = left(number1,dec-1)        frac1 = mid(number1,dec+1)    else        int1 = number1        frac1 = ""    end if       dec = instr(1,number2,".")    if dec > 0 then        int2 = left(number2,dec-1)        frac2 = mid(number2,dec+1)    else        int2 = number2        frac2 = ""    end if    dec = len(frac1)+len(frac2)    number1 = int1+frac1    number2 = int2+frac2    'swap numbers so that bigger number is number1 and smaller is number2    if len(number2) > len(number1) then swap number1,number2    if len(number1) = len(number2) then        if val(left(number2,1)) > val(left(number1,1)) then swap number1,number2    end if    'make numbers equal multiple of 7 bytes    do        str1 = str(len(number1)/7)        dec1 = instr(1,str1,".")        if dec1 <> 0 then number1 = "0" + number1    loop until dec1 = 0    do        str1 = str(len(number2)/7)        dec1 = instr(1,str1,".")        if dec1 <> 0 then number2 = "0" + number2    loop until dec1 = 0       'convert the numeric strings to use pointers    'convert number1    dim as string n1 = string(len(number1)*8,chr(0))    dim as ulongint ptr ulp1    ulp1 = cptr(ulongint ptr,strptr(n1))    dim as longint val1    dim as longint len_1 = 0    dim as uinteger a    for a = 0 to len(number1)-1 step 7        val1 = (number1[a+0]-48)*1000000ull        val1+= (number1[a+1]-48)*100000ull        val1+= (number1[a+2]-48)*10000ull        val1+= (number1[a+3]-48)*1000ull        val1+= (number1[a+4]-48)*100ull        val1+= (number1[a+5]-48)*10ull        val1+= (number1[a+6]-48)*1ull        *ulp1 = val1        ulp1+=1        len_1+=8    next    number1 = left(n1,len_1)    n1=""       'convert the numeric strings to use pointers    'convert number2    dim as string n2 = string(len(number2)*8,chr(0))    dim as ulongint ptr ulp2    ulp2 = cptr(ulongint ptr,strptr(n2))    dim as longint val2    dim as longint len_2 = 0    for a = 0 to len(number2)-1 step 7        val2 = (number2[a+0]-48)*1000000ull        val2+= (number2[a+1]-48)*100000ull        val2+= (number2[a+2]-48)*10000ull        val2+= (number2[a+3]-48)*1000ull        val2+= (number2[a+4]-48)*100ull        val2+= (number2[a+5]-48)*10ull        val2+= (number2[a+6]-48)*1ull        *ulp2 = val2        ulp2+=1        len_2+=8    next    number2 = left(n2,len_2)    n2=""       'create accumulator    answer = string( len(number1) + len(number2) + 8 , chr(0) )    'dimension vars for the mul    dim as longint ptr start1,stop1,start2,stop2 'use longint because the pointers go negative    dim as longint ptr chk_1 , chk_2    dim as longint ptr inc1,inc2    dim as longint ptr outplace    dim as ulongint carry    dim as ulongint total    dim as ulongint blocknumber1 = len(number1)/8    dim as ulongint blocknumber2 = len(number2)/8    dim as ulongint outblocks = len(answer)/8       'set initial accumulator place    outplace = cptr(longint ptr , strptr(answer)) + (outblocks - 1)    'set initial pointers into number1    start1 = cptr(longint ptr , strptr(number1))+(blocknumber1-1)    stop1 =  cptr(longint ptr , strptr(number1))+(blocknumber1-1)    'set initial pointers into number2    start2 = cptr(longint ptr , strptr(number2))+(blocknumber2-1)    stop2 =  cptr(longint ptr , strptr(number2))+(blocknumber2-1)    'set comparison to beg of numbers    chk_1 = cptr( longint ptr , strptr(number1))    chk_2 = cptr( longint ptr , strptr(number2))       'zero the carry    carry = 0       'begin looping thru strings multiplying    do        'set total to zero        total = 0        'we are going to be incrementing thru number2 while decrementing thru number1        'working in opposite directions from start1 to stop1 and start2 to stop2        'inc1 works from right to left in the top number1 string        'inc2 works from start2 to stop 2, in the bottom number2 string, decrementing each loop.        inc1 = start1        inc2 = start2        do            total += *inc1 * *inc2            inc1-= 1            inc2+= 1        loop until inc2 = stop2+1           total = total + carry        carry = total \ 1e7        *outplace = total mod 1e7        '*outplace = imod(total , 1e7)               outplace -= 1               'each loop we need to decrement stop1        'if stop1 goes negative we reset it to zero and decrement stop2        stop1 -= 1        if stop1 < chk_1 then            stop1 += 1            stop2 -=1            if stop2 < chk_2 then stop2+= 1        end if        'each loop we decrement start2 to the left        start2 -= 1        'if start2 goes negative we reset it to zero and decrement start1        'start1 is the rightmost digit of number1 we need to multiply        if start2 < chk_2 then            start2 += 1            start1 -= 1            if start1 < chk_1 then start1+=1        end if       loop until outplace = cptr(ulongint ptr,strptr(answer))+1       'put in the carry at the end    if carry > 0  then *outplace = carry else *outplace = 0       'convert answer back to ascii    for a as ulongint = 1 to outblocks-1 step 1        val1 = *outplace        outplace +=1        outtext = outtext + right("0000000" + str(val1),7)    next       'put in the decimal point    outtext = left(outtext,len(outtext)-dec) + "." +  mid(outtext,(len(outtext)-dec)+1)    'trim leading zeros    outtext = trim(outtext,"0") 'if multiplying by 1, we have a zero in front.    outtext = outsign + outtext    return outtextend function'==============================================================================='===============================================================================`
albert
Posts: 5247
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@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 stringDECLARE Function minus(NUM1 As String,NUM2 As String) As StringDeclare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As Stringscreen 19do        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)'===============================================================================sleepend'==============================================================================='==============================================================================='Dodicats plus & Minus functions'==============================================================================='===============================================================================    Function plus(_num1 As String,_num2 As String) As String        Dim  ADDQmod(0 To 19) As Ubyte        Dim  ADDbool(0 To 19) As Ubyte        For z As Integer=0 To 19            ADDQmod(z)=(z Mod 10+48)            ADDbool(z)=(-(10<=z))        Next z        Var _flag=0,n_=0        Dim As Ubyte addup=Any,addcarry=Any        #macro finish()        answer=Ltrim(answer,"0")        If _flag=1 Then Swap _num2,_num1        Return answer        #endmacro        If Len(_num2)>Len(_num1) Then            Swap _num2,_num1            _flag=1        End If        Var diff=Len(_num1)-Len(_num2)        Var answer="0"+_num1        addcarry=0        For n_=Len(_num1)-1 To diff Step -1            addup=_num2[n_-diff]+_num1[n_]-96            answer[n_+1]=ADDQmod(addup+addcarry)            addcarry=ADDbool(addup+addcarry)        Next n_        If addcarry=0 Then            finish()        End If        If n_=-1 Then            answer=addcarry+48            finish()            Endif            For n_=n_ To 0 Step -1                addup=_num1[n_]-48                answer[n_+1]=ADDQmod(addup+addcarry)                addcarry=ADDbool(addup+addcarry)                If addcarry=0 Then Exit For            Next n_            answer=addcarry+48            finish()        End Function'==============================================================================='===============================================================================Function minus(NUM1 As String,NUM2 As String) As String     'Dim As String copyfirstnum=mul_num_1,copysecondnum=mul_num_2    Dim As Byte swapflag               Dim As Long lenf,lens    Dim sign As String * 1    'Dim As String part1,part2    Dim bigger As Byte     'set up tables    Dim As Ubyte Qmod(0 To 19)    Dim bool(0 To 19) As Ubyte    For z As Integer=0 To 19        Qmod(z)=cubyte(z Mod 10+48)        bool(z)=cubyte(-(10>z))    Next z    lenf=Len(NUM1)    lens=Len(NUM2)    #macro compare(numbers)        If Lens>lenf Then bigger= -1:Goto fin        If Lens<lenf Then bigger =0:Goto fin        If NUM2>NUM1 Then            bigger=-1        Else            bigger= 0        End If        fin:    #endmacro    compare(numbers)    If bigger Then        sign="-"        Swap NUM2,NUM1        Swap lens,lenf        swapflag=1    Endif    'lenf=Len(NUM1)    'lens=Len(NUM2)    Dim diff As Long=lenf-lens-Sgn(lenf-lens)    Dim As String one,two,three    three=NUM1    two=String(lenf-lens,"0")+NUM2    one=NUM1    Dim As Long n2    Dim As Ubyte takeaway,subtractcarry    Dim As Ubyte ten=10    'Dim z As Long    subtractcarry=0    Do         For n2=lenf-1 To diff Step -1           takeaway= one[n2]-two[n2]+ten-subtractcarry           three[n2]=Qmod(takeaway)            subtractcarry=bool(takeaway)        Next n2        If subtractcarry=0 Then Exit Do        If n2=-1 Then Exit Do        For n2=n2 To 0 Step -1            takeaway= one[n2]-two[n2]+ten-subtractcarry            three[n2]=Qmod(takeaway)            subtractcarry=bool(takeaway)            Next n2        Exit Do    Loop       three=Ltrim(three,"0")    If three="" Then Return "0"    If swapflag=1 Then Swap NUM1,NUM2       Return sign+three   End Function'==============================================================================='===============================================================================function multiplier_7(byref num1 as string, byref num2 as string) as string       dim as string number1,number2    dim as string answer,outtext       dim as string int1,frac1,int2,frac2    dim as ulongint dec,dec1,len1,len2    dim as string str1    dim as string sign1,sign2,outsign       number1 = num1    number2 = num2       sign1 = left(number1,1)    if sign1 = "+" or sign1 = "-" then number1 = mid(number1,2) else sign1 = ""       sign2 = left(number2,1)    if sign2 = "+" or sign2 = "-" then number2 = mid(number2,2) else sign2 = ""       if (sign1 = sign2) then outsign = ""    if (sign1 <> sign2) then outsign = "-"       dec = instr(1,number1,".")    if dec > 0 then        int1 = left(number1,dec-1)        frac1 = mid(number1,dec+1)    else        int1 = number1        frac1 = ""    end if       dec = instr(1,number2,".")    if dec > 0 then        int2 = left(number2,dec-1)        frac2 = mid(number2,dec+1)    else        int2 = number2        frac2 = ""    end if    dec = len(frac1)+len(frac2)    number1 = int1+frac1    number2 = int2+frac2    'swap numbers so that bigger number is number1 and smaller is number2    if len(number2) > len(number1) then swap number1,number2    if len(number1) = len(number2) then        if val(left(number2,1)) > val(left(number1,1)) then swap number1,number2    end if    'make numbers equal multiple of 7 bytes    do        str1 = str(len(number1)/7)        dec1 = instr(1,str1,".")        if dec1 <> 0 then number1 = "0" + number1    loop until dec1 = 0    do        str1 = str(len(number2)/7)        dec1 = instr(1,str1,".")        if dec1 <> 0 then number2 = "0" + number2    loop until dec1 = 0       'convert the numeric strings to use pointers    'convert number1    dim as string n1 = string(len(number1)*8,chr(0))    dim as ulongint ptr ulp1    ulp1 = cptr(ulongint ptr,strptr(n1))    dim as longint val1    dim as longint len_1 = 0    dim as uinteger a    for a = 0 to len(number1)-1 step 7        val1 = (number1[a+0]-48)*1000000ull        val1+= (number1[a+1]-48)*100000ull        val1+= (number1[a+2]-48)*10000ull        val1+= (number1[a+3]-48)*1000ull        val1+= (number1[a+4]-48)*100ull        val1+= (number1[a+5]-48)*10ull        val1+= (number1[a+6]-48)*1ull        *ulp1 = val1        ulp1+=1        len_1+=8    next    number1 = left(n1,len_1)    n1=""       'convert the numeric strings to use pointers    'convert number2    dim as string n2 = string(len(number2)*8,chr(0))    dim as ulongint ptr ulp2    ulp2 = cptr(ulongint ptr,strptr(n2))    dim as longint val2    dim as longint len_2 = 0    for a = 0 to len(number2)-1 step 7        val2 = (number2[a+0]-48)*1000000ull        val2+= (number2[a+1]-48)*100000ull        val2+= (number2[a+2]-48)*10000ull        val2+= (number2[a+3]-48)*1000ull        val2+= (number2[a+4]-48)*100ull        val2+= (number2[a+5]-48)*10ull        val2+= (number2[a+6]-48)*1ull        *ulp2 = val2        ulp2+=1        len_2+=8    next    number2 = left(n2,len_2)    n2=""       'create accumulator    answer = string( len(number1) + len(number2) + 8 , chr(0) )    'dimension vars for the mul    dim as longint ptr start1,stop1,start2,stop2 'use longint because the pointers go negative    dim as longint ptr chk_1 , chk_2    dim as longint ptr inc1,inc2    dim as longint ptr outplace    dim as ulongint carry    dim as ulongint total    dim as ulongint blocknumber1 = len(number1)/8    dim as ulongint blocknumber2 = len(number2)/8    dim as ulongint outblocks = len(answer)/8       'set initial accumulator place    outplace = cptr(longint ptr , strptr(answer)) + (outblocks - 1)    'set initial pointers into number1    start1 = cptr(longint ptr , strptr(number1))+(blocknumber1-1)    stop1 =  cptr(longint ptr , strptr(number1))+(blocknumber1-1)    'set initial pointers into number2    start2 = cptr(longint ptr , strptr(number2))+(blocknumber2-1)    stop2 =  cptr(longint ptr , strptr(number2))+(blocknumber2-1)    'set comparison to beg of numbers    chk_1 = cptr( longint ptr , strptr(number1))    chk_2 = cptr( longint ptr , strptr(number2))       'zero the carry    carry = 0       'begin looping thru strings multiplying    do        'set total to zero        total = 0        'we are going to be incrementing thru number2 while decrementing thru number1        'working in opposite directions from start1 to stop1 and start2 to stop2        'inc1 works from right to left in the top number1 string        'inc2 works from start2 to stop 2, in the bottom number2 string, decrementing each loop.        inc1 = start1        inc2 = start2        do            total += *inc1 * *inc2            inc1-= 1            inc2+= 1        loop until inc2 = stop2+1           total = total + carry        carry = total \ 1e7        *outplace = total mod 1e7        '*outplace = imod(total , 1e7)               outplace -= 1               'each loop we need to decrement stop1        'if stop1 goes negative we reset it to zero and decrement stop2        stop1 -= 1        if stop1 < chk_1 then            stop1 += 1            stop2 -=1            if stop2 < chk_2 then stop2+= 1        end if        'each loop we decrement start2 to the left        start2 -= 1        'if start2 goes negative we reset it to zero and decrement start1        'start1 is the rightmost digit of number1 we need to multiply        if start2 < chk_2 then            start2 += 1            start1 -= 1            if start1 < chk_1 then start1+=1        end if       loop until outplace = cptr(ulongint ptr,strptr(answer))+1       'put in the carry at the end    if carry > 0  then *outplace = carry else *outplace = 0       'convert answer back to ascii    for a as ulongint = 1 to outblocks-1 step 1        val1 = *outplace        outplace +=1        outtext = outtext + right("0000000" + str(val1),7)    next       'put in the decimal point    outtext = left(outtext,len(outtext)-dec) + "." +  mid(outtext,(len(outtext)-dec)+1)    'trim leading zeros    outtext = trim(outtext,"0") 'if multiplying by 1, we have a zero in front.    outtext = outsign + outtext    return outtextend function'==============================================================================='===============================================================================`
albert
Posts: 5247
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@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

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

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 imageFunction 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 im2End Function'count the pixels in the shapeFunction 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 ctrEnd Function'average of 10 shape areasFunction 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 areasSub 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))=nxtEnd Sub'screen display of historySub 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 IfEnd Sub'draw a filled pentagonSub 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,colEnd Sub'=================  =============Dim As String history(1 To 10)Screen 20,32'first rectangle (a square)Dim As double side1=400Dim As double side2=400Dim As Any Ptr i=Imagecreate(side1,side2,Rgb(0,100,255))'draw a shape to ipentagon(200,220,190,Rgb(200,0,0),i)Put(30,40),iDraw String(0,0),"Rect Area = " &(side1*side2)Dim As Long area=getshapearea(i)Draw String(0,20),"Shape Area = " &areaupdatehistory(history(),Str(Area))showhistory(history(),23,70)print "press a key"SleepDim As double kDo    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 i2Loop Until Inkey=Chr(27)imagedestroy i   `
albert
Posts: 5247
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

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

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

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 :

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 stringDECLARE Function minus(NUM1 As String,NUM2 As String) As StringDeclare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As StringDeclare Function half(fl As String) As Stringdeclare function divide(as string,as string,as integer,as string ="s") as stringscreen 19do        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)'===============================================================================sleepend'================================================== '================================================== Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As String          Dim As String number=n1,divisor=n2          dpflag=lcase(dpflag)          'For MOD          dim as integer modstop          if dpflag="mod" then               if len(n1)<len(n2) then return n1              if len(n1)=len(n2) then                  if n1<n2 then return n1                  end if              modstop=len(n1)-len(n2)+1              end if          if dpflag<>"mod" then     If dpflag<>"s"  Then dpflag="raw"      end if        Dim runcount As integer        '_______  LOOK UP TABLES ______________        Dim Qmod(0 To 19) As Ubyte        Dim bool(0 To 19) As Ubyte        For z As Integer=0 To 19    Qmod(z)=(z Mod 10+48)    bool(z)=(-(10>z))Next zDim answer As String   'THE ANSWER STRING  '_______ SET THE DECIMAL WHERE IT SHOULD BE AT _______Dim As String part1,part2#macro set(decimal)#macro insert(s,char,position)If position > 0 And position <=Len(s) Thenpart1=Mid\$(s,1,position-1)part2=Mid\$(s,position)s=part1+char+part2End if#endmacroinsert(answer,".",decpos)  answer=thepoint+zeros+answerIf dpflag="raw" Then    answer=Mid(answer,1,decimal_places)    End if#endmacro'______________________________________________'__________ SPLIT A STRING ABOUT A CHARACTRR __________Dim As String var1,var2    Dim pst As integer      #macro split(stri,char,var1,var2)    pst=Instr(stri,char)    var1="":var2=""    If pst<>0 Then    var1=Rtrim(Mid(stri,1,pst),".")    var2=Ltrim(Mid(stri,pst),".")Else    var1=stri    End if    #endmacro           #macro Removepoint(s)       split(s,".",var1,var2)#endmacro'__________ GET THE SIGN AND CLEAR THE -ve __________________Dim sign As String          If Left(number,1)="-" Xor Left (divisor,1)="-" Then sign="-"            If Left(number,1)="-" Then  number=Ltrim(number,"-")            If Left (divisor,1)="-" Then divisor=Ltrim(divisor,"-")              'DETERMINE THE DECIMAL POSITION BEFORE THE DIVISIONDim As integer lennint,lenddec,lend,lenn,difflensplit(number,".",var1,var2)lennint=Len(var1)split(divisor,".",var1,var2)lenddec=Len(var2)If Instr(number,".") Then     Removepoint(number)    number=var1+var2    End ifIf Instr(divisor,".") Then     Removepoint(divisor)    divisor=var1+var2    End ifDim As integer numzerosnumzeros=Len(number)number=Ltrim(number,"0"):divisor=Ltrim (divisor,"0")numzeros=numzeros-Len(number)lend=Len(divisor):lenn=Len(number)If lend>lenn Then difflen=lend-lennDim decpos As integer=lenddec+lennint-lend+2-numzeros 'THE POSITION INDICATORDim _sgn As Byte=-Sgn(decpos)If _sgn=0 Then _sgn=1Dim As String thepoint=String(_sgn,".") 'DECIMAL AT START (IF)Dim As String zeros=String(-decpos+1,"0")'ZEROS AT START (IF) e.g. .0009if dpflag<>"mod" thenIf Len(zeros) =0 Then dpflag="s"end ifDim As integer runlengthIf Len(zeros) Then      runlength=decimal_places     answer=String(Len(zeros)+runlength+10,"0")    If dpflag="raw" Then         runlength=1        answer=String(Len(zeros)+runlength+10,"0")        If decimal_places>Len(zeros) Then            runlength=runlength+(decimal_places-Len(zeros))            answer=String(Len(zeros)+runlength+10,"0")            End If            End IfElsedecimal_places=decimal_places+decposrunlength=decimal_placesanswer=String(Len(zeros)+runlength+10,"0")End if'___________DECIMAL POSITION DETERMINED  _____________'SET UP THE VARIABLES AND START UP CONDITIONSnumber=number+String(difflen+decimal_places,"0")        Dim count As integer        Dim temp As String        Dim copytemp As String        Dim topstring As String        Dim copytopstring As String        Dim As integer lenf,lens        Dim As Ubyte takeaway,subtractcarry        Dim As integer n3,diff       If Ltrim(divisor,"0")="" Then Return "Error :division by zero"           lens=Len(divisor)         topstring=Left(number,lend)         copytopstring=topstring        Do            count=0        Do            count=count+1            copytemp=temp                Do'___________________ QUICK SUBTRACTION loop _________________                          lenf=Len(topstring)If  lens<lenf=0 Then 'notIf Lens>lenf Thentemp= "done"Exit DoEnd ifIf divisor>topstring Then temp= "done"Exit DoEnd ifEnd if  diff=lenf-lens        temp=topstring        subtractcarry=0                For n3=lenf-1 To diff Step -1            takeaway= topstring[n3]-divisor[n3-diff]+10-subtractcarry            temp[n3]=Qmod(takeaway)            subtractcarry=bool(takeaway)        Next n3         If subtractcarry=0 Then Exit Do         If n3=-1 Then Exit Do        For n3=n3 To 0 Step -1             takeaway= topstring[n3]-38-subtractcarry             temp[n3]=Qmod(takeaway)            subtractcarry=bool(takeaway)            if subtractcarry=0 then exit do            Next n3        Exit Do                Loop 'single run        temp=Ltrim(temp,"0")        If temp="" Then temp= "0"            topstring=temp        Loop Until temp="done"     ' INDIVIDUAL CHARACTERS CARVED OFF ________________               runcount=runcount+1       If count=1 Then           topstring=copytopstring+Mid(number,lend+runcount,1)           Else       topstring=copytemp+Mid(number,lend+runcount,1)   End If       copytopstring=topstring       topstring=Ltrim(topstring,"0")       if dpflag="mod" then       if runcount=modstop then            if topstring="" then return "0"           return mid(topstring,1,len(topstring)-1)           end if       end if       answer[runcount-1]=count+47       If topstring="" And runcount>Len(n1)+1 Then           Exit Do           End if   Loop Until runcount=runlength+1      ' END OF RUN TO REQUIRED DECIMAL PLACES   set(decimal) 'PUT IN THE DECIMAL POINT  'THERE IS ALWAYS A DECIMAL POINT SOMEWHERE IN THE ANSWER  'NOW GET RID OF IT IF IT IS REDUNDANT       answer=Rtrim(answer,"0")       answer=Rtrim(answer,".")       answer=Ltrim(answer,"0")       If answer="" Then Return "0"   Return sign+answerEnd Function '==============================================================================='===============================================================================Function half(fl As String) As String    Dim As Ubyte main,carry,temp    Dim As String sign   , s    If Instr(fl,".")=0 Then s=fl+".0" Else s=fl+"0"     If Instr(s,"-") Then sign="-":s=Ltrim(s,"-")    Dim As String ans=s    For z As Integer=0 To Len(s)-1        If s[z]<>46 Then             temp=(s[z]-48+carry)            main=temp Shr 1            carry=(temp And 1) Shl 3 +(temp And 1) Shl 1            ans[z]=main+48        End If    Next z    If Instr(ans,".") Then ans=Rtrim(ans,"0")    ans=Rtrim(ans,".")    ans=Ltrim(ans,"0")    Return ansEnd Function'==============================================================================='==============================================================================='Dodicats plus & Minus functions'==============================================================================='===============================================================================    Function plus(_num1 As String,_num2 As String) As String        Dim  ADDQmod(0 To 19) As Ubyte        Dim  ADDbool(0 To 19) As Ubyte        For z As Integer=0 To 19            ADDQmod(z)=(z Mod 10+48)            ADDbool(z)=(-(10<=z))        Next z        Var _flag=0,n_=0        Dim As Ubyte addup=Any,addcarry=Any        #macro finish()        answer=Ltrim(answer,"0")        If _flag=1 Then Swap _num2,_num1        Return answer        #endmacro        If Len(_num2)>Len(_num1) Then            Swap _num2,_num1            _flag=1        End If        Var diff=Len(_num1)-Len(_num2)        Var answer="0"+_num1        addcarry=0        For n_=Len(_num1)-1 To diff Step -1            addup=_num2[n_-diff]+_num1[n_]-96            answer[n_+1]=ADDQmod(addup+addcarry)            addcarry=ADDbool(addup+addcarry)        Next n_        If addcarry=0 Then            finish()        End If        If n_=-1 Then            answer=addcarry+48            finish()            Endif            For n_=n_ To 0 Step -1                addup=_num1[n_]-48                answer[n_+1]=ADDQmod(addup+addcarry)                addcarry=ADDbool(addup+addcarry)                If addcarry=0 Then Exit For            Next n_            answer=addcarry+48            finish()        End Function'==============================================================================='===============================================================================Function minus(NUM1 As String,NUM2 As String) As String     'Dim As String copyfirstnum=mul_num_1,copysecondnum=mul_num_2    Dim As Byte swapflag               Dim As Long lenf,lens    Dim sign As String * 1    'Dim As String part1,part2    Dim bigger As Byte     'set up tables    Dim As Ubyte Qmod(0 To 19)    Dim bool(0 To 19) As Ubyte    For z As Integer=0 To 19        Qmod(z)=cubyte(z Mod 10+48)        bool(z)=cubyte(-(10>z))    Next z    lenf=Len(NUM1)    lens=Len(NUM2)    #macro compare(numbers)        If Lens>lenf Then bigger= -1:Goto fin        If Lens<lenf Then bigger =0:Goto fin        If NUM2>NUM1 Then            bigger=-1        Else            bigger= 0        End If        fin:    #endmacro    compare(numbers)    If bigger Then        sign="-"        Swap NUM2,NUM1        Swap lens,lenf        swapflag=1    Endif    'lenf=Len(NUM1)    'lens=Len(NUM2)    Dim diff As Long=lenf-lens-Sgn(lenf-lens)    Dim As String one,two,three    three=NUM1    two=String(lenf-lens,"0")+NUM2    one=NUM1    Dim As Long n2    Dim As Ubyte takeaway,subtractcarry    Dim As Ubyte ten=10    'Dim z As Long    subtractcarry=0    Do         For n2=lenf-1 To diff Step -1           takeaway= one[n2]-two[n2]+ten-subtractcarry           three[n2]=Qmod(takeaway)            subtractcarry=bool(takeaway)        Next n2        If subtractcarry=0 Then Exit Do        If n2=-1 Then Exit Do        For n2=n2 To 0 Step -1            takeaway= one[n2]-two[n2]+ten-subtractcarry            three[n2]=Qmod(takeaway)            subtractcarry=bool(takeaway)            Next n2        Exit Do    Loop       three=Ltrim(three,"0")    If three="" Then Return "0"    If swapflag=1 Then Swap NUM1,NUM2       Return sign+three   End Function'==============================================================================='===============================================================================function multiplier_7(byref num1 as string, byref num2 as string) as string       dim as string number1,number2    dim as string answer,outtext       dim as string int1,frac1,int2,frac2    dim as ulongint dec,dec1,len1,len2    dim as string str1    dim as string sign1,sign2,outsign       number1 = num1    number2 = num2       sign1 = left(number1,1)    if sign1 = "+" or sign1 = "-" then number1 = mid(number1,2) else sign1 = ""       sign2 = left(number2,1)    if sign2 = "+" or sign2 = "-" then number2 = mid(number2,2) else sign2 = ""       if (sign1 = sign2) then outsign = ""    if (sign1 <> sign2) then outsign = "-"       dec = instr(1,number1,".")    if dec > 0 then        int1 = left(number1,dec-1)        frac1 = mid(number1,dec+1)    else        int1 = number1        frac1 = ""    end if       dec = instr(1,number2,".")    if dec > 0 then        int2 = left(number2,dec-1)        frac2 = mid(number2,dec+1)    else        int2 = number2        frac2 = ""    end if    dec = len(frac1)+len(frac2)    number1 = int1+frac1    number2 = int2+frac2    'swap numbers so that bigger number is number1 and smaller is number2    if len(number2) > len(number1) then swap number1,number2    if len(number1) = len(number2) then        if val(left(number2,1)) > val(left(number1,1)) then swap number1,number2    end if    'make numbers equal multiple of 7 bytes    do        str1 = str(len(number1)/7)        dec1 = instr(1,str1,".")        if dec1 <> 0 then number1 = "0" + number1    loop until dec1 = 0    do        str1 = str(len(number2)/7)        dec1 = instr(1,str1,".")        if dec1 <> 0 then number2 = "0" + number2    loop until dec1 = 0       'convert the numeric strings to use pointers    'convert number1    dim as string n1 = string(len(number1)*8,chr(0))    dim as ulongint ptr ulp1    ulp1 = cptr(ulongint ptr,strptr(n1))    dim as longint val1    dim as longint len_1 = 0    dim as uinteger a    for a = 0 to len(number1)-1 step 7        val1 = (number1[a+0]-48)*1000000ull        val1+= (number1[a+1]-48)*100000ull        val1+= (number1[a+2]-48)*10000ull        val1+= (number1[a+3]-48)*1000ull        val1+= (number1[a+4]-48)*100ull        val1+= (number1[a+5]-48)*10ull        val1+= (number1[a+6]-48)*1ull        *ulp1 = val1        ulp1+=1        len_1+=8    next    number1 = left(n1,len_1)    n1=""       'convert the numeric strings to use pointers    'convert number2    dim as string n2 = string(len(number2)*8,chr(0))    dim as ulongint ptr ulp2    ulp2 = cptr(ulongint ptr,strptr(n2))    dim as longint val2    dim as longint len_2 = 0    for a = 0 to len(number2)-1 step 7        val2 = (number2[a+0]-48)*1000000ull        val2+= (number2[a+1]-48)*100000ull        val2+= (number2[a+2]-48)*10000ull        val2+= (number2[a+3]-48)*1000ull        val2+= (number2[a+4]-48)*100ull        val2+= (number2[a+5]-48)*10ull        val2+= (number2[a+6]-48)*1ull        *ulp2 = val2        ulp2+=1        len_2+=8    next    number2 = left(n2,len_2)    n2=""       'create accumulator    answer = string( len(number1) + len(number2) + 8 , chr(0) )    'dimension vars for the mul    dim as longint ptr start1,stop1,start2,stop2 'use longint because the pointers go negative    dim as longint ptr chk_1 , chk_2    dim as longint ptr inc1,inc2    dim as longint ptr outplace    dim as ulongint carry    dim as ulongint total    dim as ulongint blocknumber1 = len(number1)/8    dim as ulongint blocknumber2 = len(number2)/8    dim as ulongint outblocks = len(answer)/8       'set initial accumulator place    outplace = cptr(longint ptr , strptr(answer)) + (outblocks - 1)    'set initial pointers into number1    start1 = cptr(longint ptr , strptr(number1))+(blocknumber1-1)    stop1 =  cptr(longint ptr , strptr(number1))+(blocknumber1-1)    'set initial pointers into number2    start2 = cptr(longint ptr , strptr(number2))+(blocknumber2-1)    stop2 =  cptr(longint ptr , strptr(number2))+(blocknumber2-1)    'set comparison to beg of numbers    chk_1 = cptr( longint ptr , strptr(number1))    chk_2 = cptr( longint ptr , strptr(number2))       'zero the carry    carry = 0       'begin looping thru strings multiplying    do        'set total to zero        total = 0        'we are going to be incrementing thru number2 while decrementing thru number1        'working in opposite directions from start1 to stop1 and start2 to stop2        'inc1 works from right to left in the top number1 string        'inc2 works from start2 to stop 2, in the bottom number2 string, decrementing each loop.        inc1 = start1        inc2 = start2        do            total += *inc1 * *inc2            inc1-= 1            inc2+= 1        loop until inc2 = stop2+1           total = total + carry        carry = total \ 1e7        *outplace = total mod 1e7        '*outplace = imod(total , 1e7)               outplace -= 1               'each loop we need to decrement stop1        'if stop1 goes negative we reset it to zero and decrement stop2        stop1 -= 1        if stop1 < chk_1 then            stop1 += 1            stop2 -=1            if stop2 < chk_2 then stop2+= 1        end if        'each loop we decrement start2 to the left        start2 -= 1        'if start2 goes negative we reset it to zero and decrement start1        'start1 is the rightmost digit of number1 we need to multiply        if start2 < chk_2 then            start2 += 1            start1 -= 1            if start1 < chk_1 then start1+=1        end if       loop until outplace = cptr(ulongint ptr,strptr(answer))+1       'put in the carry at the end    if carry > 0  then *outplace = carry else *outplace = 0       'convert answer back to ascii    for a as ulongint = 1 to outblocks-1 step 1        val1 = *outplace        outplace +=1        outtext = outtext + right("0000000" + str(val1),7)    next       'put in the decimal point    outtext = left(outtext,len(outtext)-dec) + "." +  mid(outtext,(len(outtext)-dec)+1)    'trim leading zeros    outtext = trim(outtext,"0") 'if multiplying by 1, we have a zero in front.    outtext = outsign + outtext    return outtextend function'==============================================================================='===============================================================================`
Richard
Posts: 2958
Joined: Jan 15, 2007 20:44
Location: Australia

### Re: Squares

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 :

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

@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

@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 stringDECLARE Function minus(NUM1 As String,NUM2 As String) As StringDeclare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As StringDeclare Function half(fl As String) As Stringdeclare function divide(as string,as string,as integer,as string ="s") as stringscreen 19do        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)'===============================================================================sleepend'================================================== '================================================== Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As String          Dim As String number=n1,divisor=n2          dpflag=lcase(dpflag)          'For MOD          dim as integer modstop          if dpflag="mod" then               if len(n1)<len(n2) then return n1              if len(n1)=len(n2) then                  if n1<n2 then return n1                  end if              modstop=len(n1)-len(n2)+1              end if          if dpflag<>"mod" then     If dpflag<>"s"  Then dpflag="raw"      end if        Dim runcount As integer        '_______  LOOK UP TABLES ______________        Dim Qmod(0 To 19) As Ubyte        Dim bool(0 To 19) As Ubyte        For z As Integer=0 To 19    Qmod(z)=(z Mod 10+48)    bool(z)=(-(10>z))Next zDim answer As String   'THE ANSWER STRING  '_______ SET THE DECIMAL WHERE IT SHOULD BE AT _______Dim As String part1,part2#macro set(decimal)#macro insert(s,char,position)If position > 0 And position <=Len(s) Thenpart1=Mid\$(s,1,position-1)part2=Mid\$(s,position)s=part1+char+part2End if#endmacroinsert(answer,".",decpos)  answer=thepoint+zeros+answerIf dpflag="raw" Then    answer=Mid(answer,1,decimal_places)    End if#endmacro'______________________________________________'__________ SPLIT A STRING ABOUT A CHARACTRR __________Dim As String var1,var2    Dim pst As integer      #macro split(stri,char,var1,var2)    pst=Instr(stri,char)    var1="":var2=""    If pst<>0 Then    var1=Rtrim(Mid(stri,1,pst),".")    var2=Ltrim(Mid(stri,pst),".")Else    var1=stri    End if    #endmacro           #macro Removepoint(s)       split(s,".",var1,var2)#endmacro'__________ GET THE SIGN AND CLEAR THE -ve __________________Dim sign As String          If Left(number,1)="-" Xor Left (divisor,1)="-" Then sign="-"            If Left(number,1)="-" Then  number=Ltrim(number,"-")            If Left (divisor,1)="-" Then divisor=Ltrim(divisor,"-")              'DETERMINE THE DECIMAL POSITION BEFORE THE DIVISIONDim As integer lennint,lenddec,lend,lenn,difflensplit(number,".",var1,var2)lennint=Len(var1)split(divisor,".",var1,var2)lenddec=Len(var2)If Instr(number,".") Then     Removepoint(number)    number=var1+var2    End ifIf Instr(divisor,".") Then     Removepoint(divisor)    divisor=var1+var2    End ifDim As integer numzerosnumzeros=Len(number)number=Ltrim(number,"0"):divisor=Ltrim (divisor,"0")numzeros=numzeros-Len(number)lend=Len(divisor):lenn=Len(number)If lend>lenn Then difflen=lend-lennDim decpos As integer=lenddec+lennint-lend+2-numzeros 'THE POSITION INDICATORDim _sgn As Byte=-Sgn(decpos)If _sgn=0 Then _sgn=1Dim As String thepoint=String(_sgn,".") 'DECIMAL AT START (IF)Dim As String zeros=String(-decpos+1,"0")'ZEROS AT START (IF) e.g. .0009if dpflag<>"mod" thenIf Len(zeros) =0 Then dpflag="s"end ifDim As integer runlengthIf Len(zeros) Then      runlength=decimal_places     answer=String(Len(zeros)+runlength+10,"0")    If dpflag="raw" Then         runlength=1        answer=String(Len(zeros)+runlength+10,"0")        If decimal_places>Len(zeros) Then            runlength=runlength+(decimal_places-Len(zeros))            answer=String(Len(zeros)+runlength+10,"0")            End If            End IfElsedecimal_places=decimal_places+decposrunlength=decimal_placesanswer=String(Len(zeros)+runlength+10,"0")End if'___________DECIMAL POSITION DETERMINED  _____________'SET UP THE VARIABLES AND START UP CONDITIONSnumber=number+String(difflen+decimal_places,"0")        Dim count As integer        Dim temp As String        Dim copytemp As String        Dim topstring As String        Dim copytopstring As String        Dim As integer lenf,lens        Dim As Ubyte takeaway,subtractcarry        Dim As integer n3,diff       If Ltrim(divisor,"0")="" Then Return "Error :division by zero"           lens=Len(divisor)         topstring=Left(number,lend)         copytopstring=topstring        Do            count=0        Do            count=count+1            copytemp=temp                Do'___________________ QUICK SUBTRACTION loop _________________                          lenf=Len(topstring)If  lens<lenf=0 Then 'notIf Lens>lenf Thentemp= "done"Exit DoEnd ifIf divisor>topstring Then temp= "done"Exit DoEnd ifEnd if  diff=lenf-lens        temp=topstring        subtractcarry=0                For n3=lenf-1 To diff Step -1            takeaway= topstring[n3]-divisor[n3-diff]+10-subtractcarry            temp[n3]=Qmod(takeaway)            subtractcarry=bool(takeaway)        Next n3         If subtractcarry=0 Then Exit Do         If n3=-1 Then Exit Do        For n3=n3 To 0 Step -1             takeaway= topstring[n3]-38-subtractcarry             temp[n3]=Qmod(takeaway)            subtractcarry=bool(takeaway)            if subtractcarry=0 then exit do            Next n3        Exit Do                Loop 'single run        temp=Ltrim(temp,"0")        If temp="" Then temp= "0"            topstring=temp        Loop Until temp="done"     ' INDIVIDUAL CHARACTERS CARVED OFF ________________               runcount=runcount+1       If count=1 Then           topstring=copytopstring+Mid(number,lend+runcount,1)           Else       topstring=copytemp+Mid(number,lend+runcount,1)   End If       copytopstring=topstring       topstring=Ltrim(topstring,"0")       if dpflag="mod" then       if runcount=modstop then            if topstring="" then return "0"           return mid(topstring,1,len(topstring)-1)           end if       end if       answer[runcount-1]=count+47       If topstring="" And runcount>Len(n1)+1 Then           Exit Do           End if   Loop Until runcount=runlength+1      ' END OF RUN TO REQUIRED DECIMAL PLACES   set(decimal) 'PUT IN THE DECIMAL POINT  'THERE IS ALWAYS A DECIMAL POINT SOMEWHERE IN THE ANSWER  'NOW GET RID OF IT IF IT IS REDUNDANT       answer=Rtrim(answer,"0")       answer=Rtrim(answer,".")       answer=Ltrim(answer,"0")       If answer="" Then Return "0"   Return sign+answerEnd Function '==============================================================================='===============================================================================Function half(fl As String) As String    Dim As Ubyte main,carry,temp    Dim As String sign   , s    If Instr(fl,".")=0 Then s=fl+".0" Else s=fl+"0"     If Instr(s,"-") Then sign="-":s=Ltrim(s,"-")    Dim As String ans=s    For z As Integer=0 To Len(s)-1        If s[z]<>46 Then             temp=(s[z]-48+carry)            main=temp Shr 1            carry=(temp And 1) Shl 3 +(temp And 1) Shl 1            ans[z]=main+48        End If    Next z    If Instr(ans,".") Then ans=Rtrim(ans,"0")    ans=Rtrim(ans,".")    ans=Ltrim(ans,"0")    Return ansEnd Function'==============================================================================='==============================================================================='Dodicats plus & Minus functions'==============================================================================='===============================================================================    Function plus(_num1 As String,_num2 As String) As String        Dim  ADDQmod(0 To 19) As Ubyte        Dim  ADDbool(0 To 19) As Ubyte        For z As Integer=0 To 19            ADDQmod(z)=(z Mod 10+48)            ADDbool(z)=(-(10<=z))        Next z        Var _flag=0,n_=0        Dim As Ubyte addup=Any,addcarry=Any        #macro finish()        answer=Ltrim(answer,"0")        If _flag=1 Then Swap _num2,_num1        Return answer        #endmacro        If Len(_num2)>Len(_num1) Then            Swap _num2,_num1            _flag=1        End If        Var diff=Len(_num1)-Len(_num2)        Var answer="0"+_num1        addcarry=0        For n_=Len(_num1)-1 To diff Step -1            addup=_num2[n_-diff]+_num1[n_]-96            answer[n_+1]=ADDQmod(addup+addcarry)            addcarry=ADDbool(addup+addcarry)        Next n_        If addcarry=0 Then            finish()        End If        If n_=-1 Then            answer=addcarry+48            finish()            Endif            For n_=n_ To 0 Step -1                addup=_num1[n_]-48                answer[n_+1]=ADDQmod(addup+addcarry)                addcarry=ADDbool(addup+addcarry)                If addcarry=0 Then Exit For            Next n_            answer=addcarry+48            finish()        End Function'==============================================================================='===============================================================================Function minus(NUM1 As String,NUM2 As String) As String     'Dim As String copyfirstnum=mul_num_1,copysecondnum=mul_num_2    Dim As Byte swapflag               Dim As Long lenf,lens    Dim sign As String * 1    'Dim As String part1,part2    Dim bigger As Byte     'set up tables    Dim As Ubyte Qmod(0 To 19)    Dim bool(0 To 19) As Ubyte    For z As Integer=0 To 19        Qmod(z)=cubyte(z Mod 10+48)        bool(z)=cubyte(-(10>z))    Next z    lenf=Len(NUM1)    lens=Len(NUM2)    #macro compare(numbers)        If Lens>lenf Then bigger= -1:Goto fin        If Lens<lenf Then bigger =0:Goto fin        If NUM2>NUM1 Then            bigger=-1        Else            bigger= 0        End If        fin:    #endmacro    compare(numbers)    If bigger Then        sign="-"        Swap NUM2,NUM1        Swap lens,lenf        swapflag=1    Endif    'lenf=Len(NUM1)    'lens=Len(NUM2)    Dim diff As Long=lenf-lens-Sgn(lenf-lens)    Dim As String one,two,three    three=NUM1    two=String(lenf-lens,"0")+NUM2    one=NUM1    Dim As Long n2    Dim As Ubyte takeaway,subtractcarry    Dim As Ubyte ten=10    'Dim z As Long    subtractcarry=0    Do         For n2=lenf-1 To diff Step -1           takeaway= one[n2]-two[n2]+ten-subtractcarry           three[n2]=Qmod(takeaway)            subtractcarry=bool(takeaway)        Next n2        If subtractcarry=0 Then Exit Do        If n2=-1 Then Exit Do        For n2=n2 To 0 Step -1            takeaway= one[n2]-two[n2]+ten-subtractcarry            three[n2]=Qmod(takeaway)            subtractcarry=bool(takeaway)            Next n2        Exit Do    Loop       three=Ltrim(three,"0")    If three="" Then Return "0"    If swapflag=1 Then Swap NUM1,NUM2       Return sign+three   End Function'==============================================================================='===============================================================================function multiplier_7(byref num1 as string, byref num2 as string) as string       dim as string number1,number2    dim as string answer,outtext       dim as string int1,frac1,int2,frac2    dim as ulongint dec,dec1,len1,len2    dim as string str1    dim as string sign1,sign2,outsign       number1 = num1    number2 = num2       sign1 = left(number1,1)    if sign1 = "+" or sign1 = "-" then number1 = mid(number1,2) else sign1 = ""       sign2 = left(number2,1)    if sign2 = "+" or sign2 = "-" then number2 = mid(number2,2) else sign2 = ""       if (sign1 = sign2) then outsign = ""    if (sign1 <> sign2) then outsign = "-"       dec = instr(1,number1,".")    if dec > 0 then        int1 = left(number1,dec-1)        frac1 = mid(number1,dec+1)    else        int1 = number1        frac1 = ""    end if       dec = instr(1,number2,".")    if dec > 0 then        int2 = left(number2,dec-1)        frac2 = mid(number2,dec+1)    else        int2 = number2        frac2 = ""    end if    dec = len(frac1)+len(frac2)    number1 = int1+frac1    number2 = int2+frac2    'swap numbers so that bigger number is number1 and smaller is number2    if len(number2) > len(number1) then swap number1,number2    if len(number1) = len(number2) then        if val(left(number2,1)) > val(left(number1,1)) then swap number1,number2    end if    'make numbers equal multiple of 7 bytes    do        str1 = str(len(number1)/7)        dec1 = instr(1,str1,".")        if dec1 <> 0 then number1 = "0" + number1    loop until dec1 = 0    do        str1 = str(len(number2)/7)        dec1 = instr(1,str1,".")        if dec1 <> 0 then number2 = "0" + number2    loop until dec1 = 0       'convert the numeric strings to use pointers    'convert number1    dim as string n1 = string(len(number1)*8,chr(0))    dim as ulongint ptr ulp1    ulp1 = cptr(ulongint ptr,strptr(n1))    dim as longint val1    dim as longint len_1 = 0    dim as uinteger a    for a = 0 to len(number1)-1 step 7        val1 = (number1[a+0]-48)*1000000ull        val1+= (number1[a+1]-48)*100000ull        val1+= (number1[a+2]-48)*10000ull        val1+= (number1[a+3]-48)*1000ull        val1+= (number1[a+4]-48)*100ull        val1+= (number1[a+5]-48)*10ull        val1+= (number1[a+6]-48)*1ull        *ulp1 = val1        ulp1+=1        len_1+=8    next    number1 = left(n1,len_1)    n1=""       'convert the numeric strings to use pointers    'convert number2    dim as string n2 = string(len(number2)*8,chr(0))    dim as ulongint ptr ulp2    ulp2 = cptr(ulongint ptr,strptr(n2))    dim as longint val2    dim as longint len_2 = 0    for a = 0 to len(number2)-1 step 7        val2 = (number2[a+0]-48)*1000000ull        val2+= (number2[a+1]-48)*100000ull        val2+= (number2[a+2]-48)*10000ull        val2+= (number2[a+3]-48)*1000ull        val2+= (number2[a+4]-48)*100ull        val2+= (number2[a+5]-48)*10ull        val2+= (number2[a+6]-48)*1ull        *ulp2 = val2        ulp2+=1        len_2+=8    next    number2 = left(n2,len_2)    n2=""       'create accumulator    answer = string( len(number1) + len(number2) + 8 , chr(0) )    'dimension vars for the mul    dim as longint ptr start1,stop1,start2,stop2 'use longint because the pointers go negative    dim as longint ptr chk_1 , chk_2    dim as longint ptr inc1,inc2    dim as longint ptr outplace    dim as ulongint carry    dim as ulongint total    dim as ulongint blocknumber1 = len(number1)/8    dim as ulongint blocknumber2 = len(number2)/8    dim as ulongint outblocks = len(answer)/8       'set initial accumulator place    outplace = cptr(longint ptr , strptr(answer)) + (outblocks - 1)    'set initial pointers into number1    start1 = cptr(longint ptr , strptr(number1))+(blocknumber1-1)    stop1 =  cptr(longint ptr , strptr(number1))+(blocknumber1-1)    'set initial pointers into number2    start2 = cptr(longint ptr , strptr(number2))+(blocknumber2-1)    stop2 =  cptr(longint ptr , strptr(number2))+(blocknumber2-1)    'set comparison to beg of numbers    chk_1 = cptr( longint ptr , strptr(number1))    chk_2 = cptr( longint ptr , strptr(number2))       'zero the carry    carry = 0       'begin looping thru strings multiplying    do        'set total to zero        total = 0        'we are going to be incrementing thru number2 while decrementing thru number1        'working in opposite directions from start1 to stop1 and start2 to stop2        'inc1 works from right to left in the top number1 string        'inc2 works from start2 to stop 2, in the bottom number2 string, decrementing each loop.        inc1 = start1        inc2 = start2        do            total += *inc1 * *inc2            inc1-= 1            inc2+= 1        loop until inc2 = stop2+1           total = total + carry        carry = total \ 1e7        *outplace = total mod 1e7        '*outplace = imod(total , 1e7)               outplace -= 1               'each loop we need to decrement stop1        'if stop1 goes negative we reset it to zero and decrement stop2        stop1 -= 1        if stop1 < chk_1 then            stop1 += 1            stop2 -=1            if stop2 < chk_2 then stop2+= 1        end if        'each loop we decrement start2 to the left        start2 -= 1        'if start2 goes negative we reset it to zero and decrement start1        'start1 is the rightmost digit of number1 we need to multiply        if start2 < chk_2 then            start2 += 1            start1 -= 1            if start1 < chk_1 then start1+=1        end if       loop until outplace = cptr(ulongint ptr,strptr(answer))+1       'put in the carry at the end    if carry > 0  then *outplace = carry else *outplace = 0       'convert answer back to ascii    for a as ulongint = 1 to outblocks-1 step 1        val1 = *outplace        outplace +=1        outtext = outtext + right("0000000" + str(val1),7)    next       'put in the decimal point    outtext = left(outtext,len(outtext)-dec) + "." +  mid(outtext,(len(outtext)-dec)+1)    'trim leading zeros    outtext = trim(outtext,"0") 'if multiplying by 1, we have a zero in front.    outtext = outsign + outtext    return outtextend function'==============================================================================='===============================================================================`
albert
Posts: 5247
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

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 stringDECLARE Function minus(NUM1 As String,NUM2 As String) As StringDeclare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As StringDeclare Function half(fl As String) As Stringdeclare function divide(as string,as string,as integer,as string ="s") as stringscreen 19do        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)'===============================================================================sleepend'================================================== '================================================== Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As String          Dim As String number=n1,divisor=n2          dpflag=lcase(dpflag)          'For MOD          dim as integer modstop          if dpflag="mod" then               if len(n1)<len(n2) then return n1              if len(n1)=len(n2) then                  if n1<n2 then return n1                  end if              modstop=len(n1)-len(n2)+1              end if          if dpflag<>"mod" then     If dpflag<>"s"  Then dpflag="raw"      end if        Dim runcount As integer        '_______  LOOK UP TABLES ______________        Dim Qmod(0 To 19) As Ubyte        Dim bool(0 To 19) As Ubyte        For z As Integer=0 To 19    Qmod(z)=(z Mod 10+48)    bool(z)=(-(10>z))Next zDim answer As String   'THE ANSWER STRING  '_______ SET THE DECIMAL WHERE IT SHOULD BE AT _______Dim As String part1,part2#macro set(decimal)#macro insert(s,char,position)If position > 0 And position <=Len(s) Thenpart1=Mid\$(s,1,position-1)part2=Mid\$(s,position)s=part1+char+part2End if#endmacroinsert(answer,".",decpos)  answer=thepoint+zeros+answerIf dpflag="raw" Then    answer=Mid(answer,1,decimal_places)    End if#endmacro'______________________________________________'__________ SPLIT A STRING ABOUT A CHARACTRR __________Dim As String var1,var2    Dim pst As integer      #macro split(stri,char,var1,var2)    pst=Instr(stri,char)    var1="":var2=""    If pst<>0 Then    var1=Rtrim(Mid(stri,1,pst),".")    var2=Ltrim(Mid(stri,pst),".")Else    var1=stri    End if    #endmacro           #macro Removepoint(s)       split(s,".",var1,var2)#endmacro'__________ GET THE SIGN AND CLEAR THE -ve __________________Dim sign As String          If Left(number,1)="-" Xor Left (divisor,1)="-" Then sign="-"            If Left(number,1)="-" Then  number=Ltrim(number,"-")            If Left (divisor,1)="-" Then divisor=Ltrim(divisor,"-")              'DETERMINE THE DECIMAL POSITION BEFORE THE DIVISIONDim As integer lennint,lenddec,lend,lenn,difflensplit(number,".",var1,var2)lennint=Len(var1)split(divisor,".",var1,var2)lenddec=Len(var2)If Instr(number,".") Then     Removepoint(number)    number=var1+var2    End ifIf Instr(divisor,".") Then     Removepoint(divisor)    divisor=var1+var2    End ifDim As integer numzerosnumzeros=Len(number)number=Ltrim(number,"0"):divisor=Ltrim (divisor,"0")numzeros=numzeros-Len(number)lend=Len(divisor):lenn=Len(number)If lend>lenn Then difflen=lend-lennDim decpos As integer=lenddec+lennint-lend+2-numzeros 'THE POSITION INDICATORDim _sgn As Byte=-Sgn(decpos)If _sgn=0 Then _sgn=1Dim As String thepoint=String(_sgn,".") 'DECIMAL AT START (IF)Dim As String zeros=String(-decpos+1,"0")'ZEROS AT START (IF) e.g. .0009if dpflag<>"mod" thenIf Len(zeros) =0 Then dpflag="s"end ifDim As integer runlengthIf Len(zeros) Then      runlength=decimal_places     answer=String(Len(zeros)+runlength+10,"0")    If dpflag="raw" Then         runlength=1        answer=String(Len(zeros)+runlength+10,"0")        If decimal_places>Len(zeros) Then            runlength=runlength+(decimal_places-Len(zeros))            answer=String(Len(zeros)+runlength+10,"0")            End If            End IfElsedecimal_places=decimal_places+decposrunlength=decimal_placesanswer=String(Len(zeros)+runlength+10,"0")End if'___________DECIMAL POSITION DETERMINED  _____________'SET UP THE VARIABLES AND START UP CONDITIONSnumber=number+String(difflen+decimal_places,"0")        Dim count As integer        Dim temp As String        Dim copytemp As String        Dim topstring As String        Dim copytopstring As String        Dim As integer lenf,lens        Dim As Ubyte takeaway,subtractcarry        Dim As integer n3,diff       If Ltrim(divisor,"0")="" Then Return "Error :division by zero"           lens=Len(divisor)         topstring=Left(number,lend)         copytopstring=topstring        Do            count=0        Do            count=count+1            copytemp=temp                Do'___________________ QUICK SUBTRACTION loop _________________                          lenf=Len(topstring)If  lens<lenf=0 Then 'notIf Lens>lenf Thentemp= "done"Exit DoEnd ifIf divisor>topstring Then temp= "done"Exit DoEnd ifEnd if  diff=lenf-lens        temp=topstring        subtractcarry=0                For n3=lenf-1 To diff Step -1            takeaway= topstring[n3]-divisor[n3-diff]+10-subtractcarry            temp[n3]=Qmod(takeaway)            subtractcarry=bool(takeaway)        Next n3         If subtractcarry=0 Then Exit Do         If n3=-1 Then Exit Do        For n3=n3 To 0 Step -1             takeaway= topstring[n3]-38-subtractcarry             temp[n3]=Qmod(takeaway)            subtractcarry=bool(takeaway)            if subtractcarry=0 then exit do            Next n3        Exit Do                Loop 'single run        temp=Ltrim(temp,"0")        If temp="" Then temp= "0"            topstring=temp        Loop Until temp="done"     ' INDIVIDUAL CHARACTERS CARVED OFF ________________               runcount=runcount+1       If count=1 Then           topstring=copytopstring+Mid(number,lend+runcount,1)           Else       topstring=copytemp+Mid(number,lend+runcount,1)   End If       copytopstring=topstring       topstring=Ltrim(topstring,"0")       if dpflag="mod" then       if runcount=modstop then            if topstring="" then return "0"           return mid(topstring,1,len(topstring)-1)           end if       end if       answer[runcount-1]=count+47       If topstring="" And runcount>Len(n1)+1 Then           Exit Do           End if   Loop Until runcount=runlength+1      ' END OF RUN TO REQUIRED DECIMAL PLACES   set(decimal) 'PUT IN THE DECIMAL POINT  'THERE IS ALWAYS A DECIMAL POINT SOMEWHERE IN THE ANSWER  'NOW GET RID OF IT IF IT IS REDUNDANT       answer=Rtrim(answer,"0")       answer=Rtrim(answer,".")       answer=Ltrim(answer,"0")       If answer="" Then Return "0"   Return sign+answerEnd Function '==============================================================================='===============================================================================Function half(fl As String) As String    Dim As Ubyte main,carry,temp    Dim As String sign   , s    If Instr(fl,".")=0 Then s=fl+".0" Else s=fl+"0"     If Instr(s,"-") Then sign="-":s=Ltrim(s,"-")    Dim As String ans=s    For z As Integer=0 To Len(s)-1        If s[z]<>46 Then             temp=(s[z]-48+carry)            main=temp Shr 1            carry=(temp And 1) Shl 3 +(temp And 1) Shl 1            ans[z]=main+48        End If    Next z    If Instr(ans,".") Then ans=Rtrim(ans,"0")    ans=Rtrim(ans,".")    ans=Ltrim(ans,"0")    Return ansEnd Function'==============================================================================='==============================================================================='Dodicats plus & Minus functions'==============================================================================='===============================================================================    Function plus(_num1 As String,_num2 As String) As String        Dim  ADDQmod(0 To 19) As Ubyte        Dim  ADDbool(0 To 19) As Ubyte        For z As Integer=0 To 19            ADDQmod(z)=(z Mod 10+48)            ADDbool(z)=(-(10<=z))        Next z        Var _flag=0,n_=0        Dim As Ubyte addup=Any,addcarry=Any        #macro finish()        answer=Ltrim(answer,"0")        If _flag=1 Then Swap _num2,_num1        Return answer        #endmacro        If Len(_num2)>Len(_num1) Then            Swap _num2,_num1            _flag=1        End If        Var diff=Len(_num1)-Len(_num2)        Var answer="0"+_num1        addcarry=0        For n_=Len(_num1)-1 To diff Step -1            addup=_num2[n_-diff]+_num1[n_]-96            answer[n_+1]=ADDQmod(addup+addcarry)            addcarry=ADDbool(addup+addcarry)        Next n_        If addcarry=0 Then            finish()        End If        If n_=-1 Then            answer=addcarry+48            finish()            Endif            For n_=n_ To 0 Step -1                addup=_num1[n_]-48                answer[n_+1]=ADDQmod(addup+addcarry)                addcarry=ADDbool(addup+addcarry)                If addcarry=0 Then Exit For            Next n_            answer=addcarry+48            finish()        End Function'==============================================================================='===============================================================================Function minus(NUM1 As String,NUM2 As String) As String     'Dim As String copyfirstnum=mul_num_1,copysecondnum=mul_num_2    Dim As Byte swapflag               Dim As Long lenf,lens    Dim sign As String * 1    'Dim As String part1,part2    Dim bigger As Byte     'set up tables    Dim As Ubyte Qmod(0 To 19)    Dim bool(0 To 19) As Ubyte    For z As Integer=0 To 19        Qmod(z)=cubyte(z Mod 10+48)        bool(z)=cubyte(-(10>z))    Next z    lenf=Len(NUM1)    lens=Len(NUM2)    #macro compare(numbers)        If Lens>lenf Then bigger= -1:Goto fin        If Lens<lenf Then bigger =0:Goto fin        If NUM2>NUM1 Then            bigger=-1        Else            bigger= 0        End If        fin:    #endmacro    compare(numbers)    If bigger Then        sign="-"        Swap NUM2,NUM1        Swap lens,lenf        swapflag=1    Endif    'lenf=Len(NUM1)    'lens=Len(NUM2)    Dim diff As Long=lenf-lens-Sgn(lenf-lens)    Dim As String one,two,three    three=NUM1    two=String(lenf-lens,"0")+NUM2    one=NUM1    Dim As Long n2    Dim As Ubyte takeaway,subtractcarry    Dim As Ubyte ten=10    'Dim z As Long    subtractcarry=0    Do         For n2=lenf-1 To diff Step -1           takeaway= one[n2]-two[n2]+ten-subtractcarry           three[n2]=Qmod(takeaway)            subtractcarry=bool(takeaway)        Next n2        If subtractcarry=0 Then Exit Do        If n2=-1 Then Exit Do        For n2=n2 To 0 Step -1            takeaway= one[n2]-two[n2]+ten-subtractcarry            three[n2]=Qmod(takeaway)            subtractcarry=bool(takeaway)            Next n2        Exit Do    Loop       three=Ltrim(three,"0")    If three="" Then Return "0"    If swapflag=1 Then Swap NUM1,NUM2       Return sign+three   End Function'==============================================================================='===============================================================================function multiplier_7(byref num1 as string, byref num2 as string) as string       dim as string number1,number2    dim as string answer,outtext       dim as string int1,frac1,int2,frac2    dim as ulongint dec,dec1,len1,len2    dim as string str1    dim as string sign1,sign2,outsign       number1 = num1    number2 = num2       sign1 = left(number1,1)    if sign1 = "+" or sign1 = "-" then number1 = mid(number1,2) else sign1 = ""       sign2 = left(number2,1)    if sign2 = "+" or sign2 = "-" then number2 = mid(number2,2) else sign2 = ""       if (sign1 = sign2) then outsign = ""    if (sign1 <> sign2) then outsign = "-"       dec = instr(1,number1,".")    if dec > 0 then        int1 = left(number1,dec-1)        frac1 = mid(number1,dec+1)    else        int1 = number1        frac1 = ""    end if       dec = instr(1,number2,".")    if dec > 0 then        int2 = left(number2,dec-1)        frac2 = mid(number2,dec+1)    else        int2 = number2        frac2 = ""    end if    dec = len(frac1)+len(frac2)    number1 = int1+frac1    number2 = int2+frac2    'swap numbers so that bigger number is number1 and smaller is number2    if len(number2) > len(number1) then swap number1,number2    if len(number1) = len(number2) then        if val(left(number2,1)) > val(left(number1,1)) then swap number1,number2    end if    'make numbers equal multiple of 7 bytes    do        str1 = str(len(number1)/7)        dec1 = instr(1,str1,".")        if dec1 <> 0 then number1 = "0" + number1    loop until dec1 = 0    do        str1 = str(len(number2)/7)        dec1 = instr(1,str1,".")        if dec1 <> 0 then number2 = "0" + number2    loop until dec1 = 0       'convert the numeric strings to use pointers    'convert number1    dim as string n1 = string(len(number1)*8,chr(0))    dim as ulongint ptr ulp1    ulp1 = cptr(ulongint ptr,strptr(n1))    dim as longint val1    dim as longint len_1 = 0    dim as uinteger a    for a = 0 to len(number1)-1 step 7        val1 = (number1[a+0]-48)*1000000ull        val1+= (number1[a+1]-48)*100000ull        val1+= (number1[a+2]-48)*10000ull        val1+= (number1[a+3]-48)*1000ull        val1+= (number1[a+4]-48)*100ull        val1+= (number1[a+5]-48)*10ull        val1+= (number1[a+6]-48)*1ull        *ulp1 = val1        ulp1+=1        len_1+=8    next    number1 = left(n1,len_1)    n1=""       'convert the numeric strings to use pointers    'convert number2    dim as string n2 = string(len(number2)*8,chr(0))    dim as ulongint ptr ulp2    ulp2 = cptr(ulongint ptr,strptr(n2))    dim as longint val2    dim as longint len_2 = 0    for a = 0 to len(number2)-1 step 7        val2 = (number2[a+0]-48)*1000000ull        val2+= (number2[a+1]-48)*100000ull        val2+= (number2[a+2]-48)*10000ull        val2+= (number2[a+3]-48)*1000ull        val2+= (number2[a+4]-48)*100ull        val2+= (number2[a+5]-48)*10ull        val2+= (number2[a+6]-48)*1ull        *ulp2 = val2        ulp2+=1        len_2+=8    next    number2 = left(n2,len_2)    n2=""       'create accumulator    answer = string( len(number1) + len(number2) + 8 , chr(0) )    'dimension vars for the mul    dim as longint ptr start1,stop1,start2,stop2 'use longint because the pointers go negative    dim as longint ptr chk_1 , chk_2    dim as longint ptr inc1,inc2    dim as longint ptr outplace    dim as ulongint carry    dim as ulongint total    dim as ulongint blocknumber1 = len(number1)/8    dim as ulongint blocknumber2 = len(number2)/8    dim as ulongint outblocks = len(answer)/8       'set initial accumulator place    outplace = cptr(longint ptr , strptr(answer)) + (outblocks - 1)    'set initial pointers into number1    start1 = cptr(longint ptr , strptr(number1))+(blocknumber1-1)    stop1 =  cptr(longint ptr , strptr(number1))+(blocknumber1-1)    'set initial pointers into number2    start2 = cptr(longint ptr , strptr(number2))+(blocknumber2-1)    stop2 =  cptr(longint ptr , strptr(number2))+(blocknumber2-1)    'set comparison to beg of numbers    chk_1 = cptr( longint ptr , strptr(number1))    chk_2 = cptr( longint ptr , strptr(number2))       'zero the carry    carry = 0       'begin looping thru strings multiplying    do        'set total to zero        total = 0        'we are going to be incrementing thru number2 while decrementing thru number1        'working in opposite directions from start1 to stop1 and start2 to stop2        'inc1 works from right to left in the top number1 string        'inc2 works from start2 to stop 2, in the bottom number2 string, decrementing each loop.        inc1 = start1        inc2 = start2        do            total += *inc1 * *inc2            inc1-= 1            inc2+= 1        loop until inc2 = stop2+1           total = total + carry        carry = total \ 1e7        *outplace = total mod 1e7        '*outplace = imod(total , 1e7)               outplace -= 1               'each loop we need to decrement stop1        'if stop1 goes negative we reset it to zero and decrement stop2        stop1 -= 1        if stop1 < chk_1 then            stop1 += 1            stop2 -=1            if stop2 < chk_2 then stop2+= 1        end if        'each loop we decrement start2 to the left        start2 -= 1        'if start2 goes negative we reset it to zero and decrement start1        'start1 is the rightmost digit of number1 we need to multiply        if start2 < chk_2 then            start2 += 1            start1 -= 1            if start1 < chk_1 then start1+=1        end if       loop until outplace = cptr(ulongint ptr,strptr(answer))+1       'put in the carry at the end    if carry > 0  then *outplace = carry else *outplace = 0       'convert answer back to ascii    for a as ulongint = 1 to outblocks-1 step 1        val1 = *outplace        outplace +=1        outtext = outtext + right("0000000" + str(val1),7)    next       'put in the decimal point    outtext = left(outtext,len(outtext)-dec) + "." +  mid(outtext,(len(outtext)-dec)+1)    'trim leading zeros    outtext = trim(outtext,"0") 'if multiplying by 1, we have a zero in front.    outtext = outsign + outtext    return outtextend function'==============================================================================='===============================================================================`
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

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 stringDECLARE Function minus(NUM1 As String,NUM2 As String) As StringDeclare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As StringDeclare Function half(fl As String) As Stringdeclare function divide(as string,as string,as integer,as string ="s") as stringscreen 19do        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)'===============================================================================sleepend'================================================== '================================================== Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As String          Dim As String number=n1,divisor=n2          dpflag=lcase(dpflag)          'For MOD          dim as integer modstop          if dpflag="mod" then               if len(n1)<len(n2) then return n1              if len(n1)=len(n2) then                  if n1<n2 then return n1                  end if              modstop=len(n1)-len(n2)+1              end if          if dpflag<>"mod" then     If dpflag<>"s"  Then dpflag="raw"      end if        Dim runcount As integer        '_______  LOOK UP TABLES ______________        Dim Qmod(0 To 19) As Ubyte        Dim bool(0 To 19) As Ubyte        For z As Integer=0 To 19    Qmod(z)=(z Mod 10+48)    bool(z)=(-(10>z))Next zDim answer As String   'THE ANSWER STRING  '_______ SET THE DECIMAL WHERE IT SHOULD BE AT _______Dim As String part1,part2#macro set(decimal)#macro insert(s,char,position)If position > 0 And position <=Len(s) Thenpart1=Mid\$(s,1,position-1)part2=Mid\$(s,position)s=part1+char+part2End if#endmacroinsert(answer,".",decpos)  answer=thepoint+zeros+answerIf dpflag="raw" Then    answer=Mid(answer,1,decimal_places)    End if#endmacro'______________________________________________'__________ SPLIT A STRING ABOUT A CHARACTRR __________Dim As String var1,var2    Dim pst As integer      #macro split(stri,char,var1,var2)    pst=Instr(stri,char)    var1="":var2=""    If pst<>0 Then    var1=Rtrim(Mid(stri,1,pst),".")    var2=Ltrim(Mid(stri,pst),".")Else    var1=stri    End if    #endmacro           #macro Removepoint(s)       split(s,".",var1,var2)#endmacro'__________ GET THE SIGN AND CLEAR THE -ve __________________Dim sign As String          If Left(number,1)="-" Xor Left (divisor,1)="-" Then sign="-"            If Left(number,1)="-" Then  number=Ltrim(number,"-")            If Left (divisor,1)="-" Then divisor=Ltrim(divisor,"-")              'DETERMINE THE DECIMAL POSITION BEFORE THE DIVISIONDim As integer lennint,lenddec,lend,lenn,difflensplit(number,".",var1,var2)lennint=Len(var1)split(divisor,".",var1,var2)lenddec=Len(var2)If Instr(number,".") Then     Removepoint(number)    number=var1+var2    End ifIf Instr(divisor,".") Then     Removepoint(divisor)    divisor=var1+var2    End ifDim As integer numzerosnumzeros=Len(number)number=Ltrim(number,"0"):divisor=Ltrim (divisor,"0")numzeros=numzeros-Len(number)lend=Len(divisor):lenn=Len(number)If lend>lenn Then difflen=lend-lennDim decpos As integer=lenddec+lennint-lend+2-numzeros 'THE POSITION INDICATORDim _sgn As Byte=-Sgn(decpos)If _sgn=0 Then _sgn=1Dim As String thepoint=String(_sgn,".") 'DECIMAL AT START (IF)Dim As String zeros=String(-decpos+1,"0")'ZEROS AT START (IF) e.g. .0009if dpflag<>"mod" thenIf Len(zeros) =0 Then dpflag="s"end ifDim As integer runlengthIf Len(zeros) Then      runlength=decimal_places     answer=String(Len(zeros)+runlength+10,"0")    If dpflag="raw" Then         runlength=1        answer=String(Len(zeros)+runlength+10,"0")        If decimal_places>Len(zeros) Then            runlength=runlength+(decimal_places-Len(zeros))            answer=String(Len(zeros)+runlength+10,"0")            End If            End IfElsedecimal_places=decimal_places+decposrunlength=decimal_placesanswer=String(Len(zeros)+runlength+10,"0")End if'___________DECIMAL POSITION DETERMINED  _____________'SET UP THE VARIABLES AND START UP CONDITIONSnumber=number+String(difflen+decimal_places,"0")        Dim count As integer        Dim temp As String        Dim copytemp As String        Dim topstring As String        Dim copytopstring As String        Dim As integer lenf,lens        Dim As Ubyte takeaway,subtractcarry        Dim As integer n3,diff       If Ltrim(divisor,"0")="" Then Return "Error :division by zero"           lens=Len(divisor)         topstring=Left(number,lend)         copytopstring=topstring        Do            count=0        Do            count=count+1            copytemp=temp                Do'___________________ QUICK SUBTRACTION loop _________________                          lenf=Len(topstring)If  lens<lenf=0 Then 'notIf Lens>lenf Thentemp= "done"Exit DoEnd ifIf divisor>topstring Then temp= "done"Exit DoEnd ifEnd if  diff=lenf-lens        temp=topstring        subtractcarry=0                For n3=lenf-1 To diff Step -1            takeaway= topstring[n3]-divisor[n3-diff]+10-subtractcarry            temp[n3]=Qmod(takeaway)            subtractcarry=bool(takeaway)        Next n3         If subtractcarry=0 Then Exit Do         If n3=-1 Then Exit Do        For n3=n3 To 0 Step -1             takeaway= topstring[n3]-38-subtractcarry             temp[n3]=Qmod(takeaway)            subtractcarry=bool(takeaway)            if subtractcarry=0 then exit do            Next n3        Exit Do                Loop 'single run        temp=Ltrim(temp,"0")        If temp="" Then temp= "0"            topstring=temp        Loop Until temp="done"     ' INDIVIDUAL CHARACTERS CARVED OFF ________________               runcount=runcount+1       If count=1 Then           topstring=copytopstring+Mid(number,lend+runcount,1)           Else       topstring=copytemp+Mid(number,lend+runcount,1)   End If       copytopstring=topstring       topstring=Ltrim(topstring,"0")       if dpflag="mod" then       if runcount=modstop then            if topstring="" then return "0"           return mid(topstring,1,len(topstring)-1)           end if       end if       answer[runcount-1]=count+47       If topstring="" And runcount>Len(n1)+1 Then           Exit Do           End if   Loop Until runcount=runlength+1      ' END OF RUN TO REQUIRED DECIMAL PLACES   set(decimal) 'PUT IN THE DECIMAL POINT  'THERE IS ALWAYS A DECIMAL POINT SOMEWHERE IN THE ANSWER  'NOW GET RID OF IT IF IT IS REDUNDANT       answer=Rtrim(answer,"0")       answer=Rtrim(answer,".")       answer=Ltrim(answer,"0")       If answer="" Then Return "0"   Return sign+answerEnd Function '==============================================================================='===============================================================================Function half(fl As String) As String    Dim As Ubyte main,carry,temp    Dim As String sign   , s    If Instr(fl,".")=0 Then s=fl+".0" Else s=fl+"0"     If Instr(s,"-") Then sign="-":s=Ltrim(s,"-")    Dim As String ans=s    For z As Integer=0 To Len(s)-1        If s[z]<>46 Then             temp=(s[z]-48+carry)            main=temp Shr 1            carry=(temp And 1) Shl 3 +(temp And 1) Shl 1            ans[z]=main+48        End If    Next z    If Instr(ans,".") Then ans=Rtrim(ans,"0")    ans=Rtrim(ans,".")    ans=Ltrim(ans,"0")    Return ansEnd Function'==============================================================================='==============================================================================='Dodicats plus & Minus functions'==============================================================================='===============================================================================    Function plus(_num1 As String,_num2 As String) As String        Dim  ADDQmod(0 To 19) As Ubyte        Dim  ADDbool(0 To 19) As Ubyte        For z As Integer=0 To 19            ADDQmod(z)=(z Mod 10+48)            ADDbool(z)=(-(10<=z))        Next z        Var _flag=0,n_=0        Dim As Ubyte addup=Any,addcarry=Any        #macro finish()        answer=Ltrim(answer,"0")        If _flag=1 Then Swap _num2,_num1        Return answer        #endmacro        If Len(_num2)>Len(_num1) Then            Swap _num2,_num1            _flag=1        End If        Var diff=Len(_num1)-Len(_num2)        Var answer="0"+_num1        addcarry=0        For n_=Len(_num1)-1 To diff Step -1            addup=_num2[n_-diff]+_num1[n_]-96            answer[n_+1]=ADDQmod(addup+addcarry)            addcarry=ADDbool(addup+addcarry)        Next n_        If addcarry=0 Then            finish()        End If        If n_=-1 Then            answer=addcarry+48            finish()            Endif            For n_=n_ To 0 Step -1                addup=_num1[n_]-48                answer[n_+1]=ADDQmod(addup+addcarry)                addcarry=ADDbool(addup+addcarry)                If addcarry=0 Then Exit For            Next n_            answer=addcarry+48            finish()        End Function'==============================================================================='===============================================================================Function minus(NUM1 As String,NUM2 As String) As String     'Dim As String copyfirstnum=mul_num_1,copysecondnum=mul_num_2    Dim As Byte swapflag               Dim As Long lenf,lens    Dim sign As String * 1    'Dim As String part1,part2    Dim bigger As Byte     'set up tables    Dim As Ubyte Qmod(0 To 19)    Dim bool(0 To 19) As Ubyte    For z As Integer=0 To 19        Qmod(z)=cubyte(z Mod 10+48)        bool(z)=cubyte(-(10>z))    Next z    lenf=Len(NUM1)    lens=Len(NUM2)    #macro compare(numbers)        If Lens>lenf Then bigger= -1:Goto fin        If Lens<lenf Then bigger =0:Goto fin        If NUM2>NUM1 Then            bigger=-1        Else            bigger= 0        End If        fin:    #endmacro    compare(numbers)    If bigger Then        sign="-"        Swap NUM2,NUM1        Swap lens,lenf        swapflag=1    Endif    'lenf=Len(NUM1)    'lens=Len(NUM2)    Dim diff As Long=lenf-lens-Sgn(lenf-lens)    Dim As String one,two,three    three=NUM1    two=String(lenf-lens,"0")+NUM2    one=NUM1    Dim As Long n2    Dim As Ubyte takeaway,subtractcarry    Dim As Ubyte ten=10    'Dim z As Long    subtractcarry=0    Do         For n2=lenf-1 To diff Step -1           takeaway= one[n2]-two[n2]+ten-subtractcarry           three[n2]=Qmod(takeaway)            subtractcarry=bool(takeaway)        Next n2        If subtractcarry=0 Then Exit Do        If n2=-1 Then Exit Do        For n2=n2 To 0 Step -1            takeaway= one[n2]-two[n2]+ten-subtractcarry            three[n2]=Qmod(takeaway)            subtractcarry=bool(takeaway)            Next n2        Exit Do    Loop       three=Ltrim(three,"0")    If three="" Then Return "0"    If swapflag=1 Then Swap NUM1,NUM2       Return sign+three   End Function'==============================================================================='===============================================================================function multiplier_7(byref num1 as string, byref num2 as string) as string       dim as string number1,number2    dim as string answer,outtext       dim as string int1,frac1,int2,frac2    dim as ulongint dec,dec1,len1,len2    dim as string str1    dim as string sign1,sign2,outsign       number1 = num1    number2 = num2       sign1 = left(number1,1)    if sign1 = "+" or sign1 = "-" then number1 = mid(number1,2) else sign1 = ""       sign2 = left(number2,1)    if sign2 = "+" or sign2 = "-" then number2 = mid(number2,2) else sign2 = ""       if (sign1 = sign2) then outsign = ""    if (sign1 <> sign2) then outsign = "-"       dec = instr(1,number1,".")    if dec > 0 then        int1 = left(number1,dec-1)        frac1 = mid(number1,dec+1)    else        int1 = number1        frac1 = ""    end if       dec = instr(1,number2,".")    if dec > 0 then        int2 = left(number2,dec-1)        frac2 = mid(number2,dec+1)    else        int2 = number2        frac2 = ""    end if    dec = len(frac1)+len(frac2)    number1 = int1+frac1    number2 = int2+frac2    'swap numbers so that bigger number is number1 and smaller is number2    if len(number2) > len(number1) then swap number1,number2    if len(number1) = len(number2) then        if val(left(number2,1)) > val(left(number1,1)) then swap number1,number2    end if    'make numbers equal multiple of 7 bytes    do        str1 = str(len(number1)/7)        dec1 = instr(1,str1,".")        if dec1 <> 0 then number1 = "0" + number1    loop until dec1 = 0    do        str1 = str(len(number2)/7)        dec1 = instr(1,str1,".")        if dec1 <> 0 then number2 = "0" + number2    loop until dec1 = 0       'convert the numeric strings to use pointers    'convert number1    dim as string n1 = string(len(number1)*8,chr(0))    dim as ulongint ptr ulp1    ulp1 = cptr(ulongint ptr,strptr(n1))    dim as longint val1    dim as longint len_1 = 0    dim as uinteger a    for a = 0 to len(number1)-1 step 7        val1 = (number1[a+0]-48)*1000000ull        val1+= (number1[a+1]-48)*100000ull        val1+= (number1[a+2]-48)*10000ull        val1+= (number1[a+3]-48)*1000ull        val1+= (number1[a+4]-48)*100ull        val1+= (number1[a+5]-48)*10ull        val1+= (number1[a+6]-48)*1ull        *ulp1 = val1        ulp1+=1        len_1+=8    next    number1 = left(n1,len_1)    n1=""       'convert the numeric strings to use pointers    'convert number2    dim as string n2 = string(len(number2)*8,chr(0))    dim as ulongint ptr ulp2    ulp2 = cptr(ulongint ptr,strptr(n2))    dim as longint val2    dim as longint len_2 = 0    for a = 0 to len(number2)-1 step 7        val2 = (number2[a+0]-48)*1000000ull        val2+= (number2[a+1]-48)*100000ull        val2+= (number2[a+2]-48)*10000ull        val2+= (number2[a+3]-48)*1000ull        val2+= (number2[a+4]-48)*100ull        val2+= (number2[a+5]-48)*10ull        val2+= (number2[a+6]-48)*1ull        *ulp2 = val2        ulp2+=1        len_2+=8    next    number2 = left(n2,len_2)    n2=""       'create accumulator    answer = string( len(number1) + len(number2) + 8 , chr(0) )    'dimension vars for the mul    dim as longint ptr start1,stop1,start2,stop2 'use longint because the pointers go negative    dim as longint ptr chk_1 , chk_2    dim as longint ptr inc1,inc2    dim as longint ptr outplace    dim as ulongint carry    dim as ulongint total    dim as ulongint blocknumber1 = len(number1)/8    dim as ulongint blocknumber2 = len(number2)/8    dim as ulongint outblocks = len(answer)/8       'set initial accumulator place    outplace = cptr(longint ptr , strptr(answer)) + (outblocks - 1)    'set initial pointers into number1    start1 = cptr(longint ptr , strptr(number1))+(blocknumber1-1)    stop1 =  cptr(longint ptr , strptr(number1))+(blocknumber1-1)    'set initial pointers into number2    start2 = cptr(longint ptr , strptr(number2))+(blocknumber2-1)    stop2 =  cptr(longint ptr , strptr(number2))+(blocknumber2-1)    'set comparison to beg of numbers    chk_1 = cptr( longint ptr , strptr(number1))    chk_2 = cptr( longint ptr , strptr(number2))       'zero the carry    carry = 0       'begin looping thru strings multiplying    do        'set total to zero        total = 0        'we are going to be incrementing thru number2 while decrementing thru number1        'working in opposite directions from start1 to stop1 and start2 to stop2        'inc1 works from right to left in the top number1 string        'inc2 works from start2 to stop 2, in the bottom number2 string, decrementing each loop.        inc1 = start1        inc2 = start2        do            total += *inc1 * *inc2            inc1-= 1            inc2+= 1        loop until inc2 = stop2+1           total = total + carry        carry = total \ 1e7        *outplace = total mod 1e7        '*outplace = imod(total , 1e7)               outplace -= 1               'each loop we need to decrement stop1        'if stop1 goes negative we reset it to zero and decrement stop2        stop1 -= 1        if stop1 < chk_1 then            stop1 += 1            stop2 -=1            if stop2 < chk_2 then stop2+= 1        end if        'each loop we decrement start2 to the left        start2 -= 1        'if start2 goes negative we reset it to zero and decrement start1        'start1 is the rightmost digit of number1 we need to multiply        if start2 < chk_2 then            start2 += 1            start1 -= 1            if start1 < chk_1 then start1+=1        end if       loop until outplace = cptr(ulongint ptr,strptr(answer))+1       'put in the carry at the end    if carry > 0  then *outplace = carry else *outplace = 0       'convert answer back to ascii    for a as ulongint = 1 to outblocks-1 step 1        val1 = *outplace        outplace +=1        outtext = outtext + right("0000000" + str(val1),7)    next       'put in the decimal point    outtext = left(outtext,len(outtext)-dec) + "." +  mid(outtext,(len(outtext)-dec)+1)    'trim leading zeros    outtext = trim(outtext,"0") 'if multiplying by 1, we have a zero in front.    outtext = outsign + outtext    return outtextend function'==============================================================================='===============================================================================`