Squares

[dodicat]

My literary background is psychoanalysis and deconstruction, so everything anyone writes I try to diagnose.

I'll be safe enough Rollie~, you can't get much change out of a bail of straw.
By the way, I did my usual system restore point and tried your sandbox.
Some nice stuff.
If I borrow some of your own stuff, and Richard's snippets, I'll be able to make some masterpieces in the way of screensavers.
But I do promise that they shall go no further than Ebay.

[albert]

@Dodicat

I got a subtract function added to the Add function they both are floating point. While i was posting this i noticed your macros on page 6,i'll use them to do the next compare.

Code: Select all

declare function add( n1 as string , n2 as string) as string 'floating point addition routine.
declare Function plus(NUM1 As String,NUM2 As String) As String 'Dodicats integer addition routine.

declare function subtract(n1 as string,n2 as string) as string 'floating point subtraction routine
declare Function minus(NUM1 As String,NUM2 As String) As String 'Dodicats integer subtraction routine

dim as string n1,n2
dim as string add_answer1,add_answer2
dim as string sub_answer1,sub_answer2

dim as double ts1,te1,tt1
dim as double ts2,te2,tt2

do
    'setup number 1
    n1=string(20000000,"2")'+"."+string(30,"1")
   
    'setup number 2
    n2=string(20000000,"1")'+"."+string(30,"1")
   
    'print n1
    'print
    'print n2
    'print
   
    ts1=timer
    add_answer1=add(n1,n2)
    te1=timer
    tt1=te1-ts1
    'print answer1
    print "albert's Add "; tt1
   
    ts2=timer
    add_answer2=plus(n1,n2)
    te2=timer
    tt2=te2-ts2
    'print answer2
    print "Dodicats Add "; tt2
    print
   
    ts1=timer
    sub_answer1=subtract(n1,n2)
    te1=timer
    tt1=te1-ts1
    'print answer1
    print "Albert's Subtract "; tt1
   
    ts2=timer
    sub_answer2=minus(n1,n2)
    te2=timer
    tt2=te2-ts2
    'print answer2
    print "Dodicats Subtract ";tt2
    print

    if inkey =" " then sleep
    if inkey = chr(27) then end

loop

sleep

END

'=================================================
'alberts addition function
'=================================================
function add(n1 as string,n2 as string) as string
    dim as string num1 = n1 ,num2 = n2
    dim as ulongint len1,len2
    dim as string answer
    dim as integer carry
    dim as integer val1,val2,tot
   
    dim as string int1,frac1
    dim as string int2,frac2
    dim as ulongint dec1,dec2
   
    dec1=instr(1,num1,".")
    if dec1 >= 1 then
        int1=left(num1,dec1-1)
        frac1=mid(num1,dec1+1)
    else
        int1 = num1
        frac1=""
    end if
   
    dec2=instr(1,num2,".")
    if dec2 >= 1 then
        int2=left(num2,dec2-1)
        frac2=mid(num2,dec2+1)
    else
        int2 = num2
        frac2=""
    end if
   
   
    if len(int1)<len(int2) then int1 = int1 + string(len(int2)-len(int1),"0")
    if len(int2)<len(int1) then int2 = int2 + string(len(int1)-len(int2),"0")
    if len(frac1)<len(frac2) then frac1 = frac1 + string(len(frac2)-len(frac1),"0")
    if len(frac2)<len(frac1) then frac2 = frac2 + string(len(frac1)-len(frac2),"0")
   
    num1=int1+"."+frac1
    num2=int2+"."+frac2

    len1=len(num1)
    len2=len(num2)
   
    answer = string(len1,"0")
    carry=0
   
    dim as ulongint l1,l2,la
    l1=len(num1)-1
    l2=len(num2)-1
    la=len(answer)-1
   
    dim as ubyte ptr pt1,pt2,pta
    pt1 = cptr(ubyte ptr , strptr(num1))+l1
    pt2 = cptr(ubyte ptr , strptr(num2))+l2
    pta = cptr(ubyte ptr , strptr(answer))+la

    for a as integer = len1-1 to 0 step -1
        val1=*pt1-48
        val2=*pt2-48
        if val2>=0 then
            tot = (val1)+(val2)+carry+48
            carry=0
            if tot >=58 then
                carry=1
                *pta = tot-10
            else
                *pta = tot
            end if
        else
            *pta=46
        end if
        pt1-=1
        pt2-=1
        pta-=1
    next
   
    if carry>0 then answer=str(carry)+answer
   
    return answer
end function   
'=======================================================
'alberts subtraction function
'=======================================================
function subtract(n1 as string,n2 as string) as string
    dim as string num1 = n1 ,num2 = n2
    dim as ulongint len1,len2
    dim as string answer
    dim as integer borrow,carry
    dim as integer val1,val2,tot
   
    dim as string int1,frac1
    dim as string int2,frac2
    dim as ulongint dec1,dec2
   
    dec1=instr(1,num1,".")
    if dec1 >= 1 then
        int1=left(num1,dec1-1)
        frac1=mid(num1,dec1+1)
    else
        int1 = num1
        frac1=""
    end if
   
    dec2=instr(1,num2,".")
    if dec2 >= 1 then
        int2=left(num2,dec2-1)
        frac2=mid(num2,dec2+1)
    else
        int2 = num2
        frac2=""
    end if
   
    if len(int1)<len(int2) then int1 = int1 + string(len(int2)-len(int1),"0")
    if len(int2)<len(int1) then int2 = int2 + string(len(int1)-len(int2),"0")
    if len(frac1)<len(frac2) then frac1 = frac1 + string(len(frac2)-len(frac1),"0")
    if len(frac2)<len(frac1) then frac2 = frac2 + string(len(frac1)-len(frac2),"0")
   
    num1=int1+"."+frac1
    num2=int2+"."+frac2

    len1=len(num1)
    len2=len(num2)

    'put larger number on top
    dim as ulongint count
    count = 0
    do
        val1 = num1[count]
        val2 = num2[count]
   
        If val1 > val2 then exit do
        If val2 > val1 then swap num1,num2:exit do
   
        count = count + 1
   
    loop until count=len1
   
    answer = string(len1,"0")
    borrow=0
    carry=0
   
    dim as ulongint l1,l2,la
    l1=len(num1)-1
    l2=len(num2)-1
    la=len(answer)-1
   
    dim as ubyte ptr pt1,pt2,pta
    pt1 = cptr(ubyte ptr , strptr(num1))+l1
    pt2 = cptr(ubyte ptr , strptr(num2))+l2
    pta = cptr(ubyte ptr , strptr(answer))+la

    for a as integer = len1-1 to 0 step -1
        val1=*pt1-48
        val2=*pt2-48
        if val1=-2 then
            *pta=46
        else   
            If borrow = 1 then If val1 > 0 then val1-= borrow : borrow = 0 else val1=9
            If val1 < val2 then val1 += 10 : borrow = 1
            *pta = val1-val2+48
        end if
       
        pt1-=1
        pt2-=1
        pta-=1
    next

    return answer
end function   

'===================================================
'dodicats plus function
'===================================================
Function plus(NUM1 As String,NUM2 As String) As String
        Dim As Long lenf,lens
        Dim As Byte flag
        'Dim As String part1,part2
         '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

'macro insert a character into a string unused yet
'#macro insert(s,char,position)
 'part1=Mid$(s,1,position-1)
 'part2=Mid$(s,position)
 's=part1+char+part2
 '#endmacro
 
 #macro finish(three)
  three=Ltrim(three,"0")
        If three="" Then Return "0"
       If flag=1 Then Swap NUM2,NUM1
       Return three
       Exit Function
 #endmacro
 lenf=Len(NUM1)
 lens=Len(NUM2)
 If lens>lenf Then
 Swap NUM2,NUM1
 Swap lens,lenf
 flag=1
 Endif

        Dim diff As Long=lenf-lens-Sgn(lenf-lens)
        Dim As String two,three',one
        three="0"+NUM1
        two=String(lenf-lens,"0")+NUM2
        Dim As Long n2
        Dim As Ubyte addup,addcarry
        Dim As Ubyte ten=10
        Dim As Ubyte ninetysix=96
        Dim As Ubyte fortyeight=48
        Dim As Ubyte zero=0
        addcarry=zero
           
         For n2=lenf-1 To diff Step -1
          addup=two[n2]+NUM1[n2]-ninetysix
            three[n2+1]=Qmod(addup+addcarry)
            addcarry=bool(addup+addcarry)
        Next n2
       
        If addcarry=zero Then
        finish(three)
        Endif
        If n2=-1 Then
        three[0]=addcarry+fortyeight
         finish(three)
        Endif

        For n2=n2 To 0 Step -1
             addup=two[n2]+NUM1[n2]-ninetysix
               three[n2+1]=Qmod(addup+addcarry)
            addcarry=bool(addup+addcarry)
        Next n2
        three[0]=addcarry+fortyeight
    finish(three)
End Function

'===================================================
'dodicats minus function
'===================================================
Function minus(NUM1 As String,NUM2 As String) As String
    'Dim As String copyfirstnum=number1,copysecondnum=number2
        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
'macro insert a character into a string
'#macro insert(s,char,position)
 'part1=Mid$(s,1,position-1)
 'part2=Mid$(s,position)
 's=part1+char+part2
' #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



[dodicat]

@Dodicat

I got a subtract function added to the Add function they both are floating point. While i was posting this i noticed your macros on page 6,i'll use them to do the next compare.

Hi Albert
could you check your subtract for small numbers?

Code: Select all


Function subtract(n1 As String,n2 As String) As String
    Dim As String num1 = n1 ,num2 = n2
    Dim As Ulongint len1,len2
    Dim As String answer
    Dim As Integer borrow,carry
    Dim As Integer val1,val2,tot
   
    Dim As String int1,frac1
    Dim As String int2,frac2
    Dim As Ulongint dec1,dec2
   
    dec1=Instr(1,num1,".")
    If dec1 >= 1 Then
        int1=Left(num1,dec1-1)
        frac1=Mid(num1,dec1+1)
    Else
        int1 = num1
        frac1=""
    End If
   
    dec2=Instr(1,num2,".")
    If dec2 >= 1 Then
        int2=Left(num2,dec2-1)
        frac2=Mid(num2,dec2+1)
    Else
        int2 = num2
        frac2=""
    End If
   
    If Len(int1)<len(int2) Then int1 = int1 + String(Len(int2)-Len(int1),"0")
    If Len(int2)<len(int1) Then int2 = int2 + String(Len(int1)-Len(int2),"0")
    If Len(frac1)<len(frac2) Then frac1 = frac1 + String(Len(frac2)-Len(frac1),"0")
    If Len(frac2)<len(frac1) Then frac2 = frac2 + String(Len(frac1)-Len(frac2),"0")
   
    num1=int1+"."+frac1
    num2=int2+"."+frac2

    len1=Len(num1)
    len2=Len(num2)

    'put larger number on top
    Dim As Ulongint count
    count = 0
    Do
        val1 = num1[count]
        val2 = num2[count]
   
        If val1 > val2 Then Exit Do
        If val2 > val1 Then Swap num1,num2:Exit Do
   
        count = count + 1
   
    Loop Until count=len1
   
    answer = String(len1,"0")
    borrow=0
    carry=0
   
    Dim As Ulongint l1,l2,la
    l1=Len(num1)-1
    l2=Len(num2)-1
    la=Len(answer)-1
   
    Dim As Ubyte Ptr pt1,pt2,pta
    pt1 = cptr(Ubyte Ptr , Strptr(num1))+l1
    pt2 = cptr(Ubyte Ptr , Strptr(num2))+l2
    pta = cptr(Ubyte Ptr , Strptr(answer))+la

    For a As Integer = len1-1 To 0 Step -1
        val1=*pt1-48
        val2=*pt2-48
        If val1=-2 Then
            *pta=46
        Else   
            If borrow = 1 Then If val1 > 0 Then val1-= borrow : borrow = 0 Else val1=9
            If val1 < val2 Then val1 += 10 : borrow = 1
            *pta = val1-val2+48
        End If
       
        pt1-=1
        pt2-=1
        pta-=1
    Next

    Return answer
End Function   
'***
dim as string s1,s2,s3
s1="123456"
s2="1"
s3=subtract(s1,s2)
print s1;"  -  ";s2
print s3
sleep


I've got my add to float now, it slows it a bit of course, maybe have to do it better.
I've compared adding with your add and my _add, putting in the decimals.
Your subtract (which I have used to check the answers) puts out a pile of zeros, a point, and another pile of zeros.
i.e.
0000.00000000 for 0
so I've trimmed, you'll see in the code.

Code: Select all


'*************** START DODICAT _PLUS AND _MINUS ************************
declare function _add(number1 as string,number2 as string) as string
'set the variables

dim shared As Long num1_length,num2_length,diff
dim shared As Ubyte add_Qmod(0 To 19)
dim shared As Ubyte sub_qmod(0 To 19)
dim shared add_bool(0 To 19) As Ubyte
dim shared sub_bool(0 To 19) As Ubyte
For z As Integer=0 To 19
    add_Qmod(z)=cubyte(z Mod 10+48)
    add_bool(z)=cubyte(-(10<=z))
   
    sub_Qmod(z)=cubyte(z Mod 10+48)
    sub_bool(z)=cubyte(-(10>z))
Next z
        dim shared As Byte swap_flag
        dim shared bigger As Byte
        dim shared As String Macro_answer,_two',one
        dim shared As Long _z
        dim shared As Ubyte carry_under,carry_over
        dim shared As Ubyte ten=10
        dim shared As Ubyte ninetysix=96
        dim shared As Ubyte fortyeight=48
        dim shared As Ubyte zero=0
        dim shared sign As String * 1
   
   ' END OF SETUP
   
   dim shared as string part1,part2
#macro insert(s,char,position)
if position>0 and position<=len(s) then
 part1=Mid$(s,1,position-1)
 part2=Mid$(s,position)
 s=part1+char+part2
 end if
 #endmacro
dim shared As Long n,pst
dim shared as string var1,var2
      #macro split(stri,char)
    pst=Instr(stri,char)
    var1="":var2=""
    If pst<>0 Then
    var1=Mid(stri,1,pst-1)
    var2=Mid(stri,pst+1)
Else
    var1=stri
    Endif
    #endmacro
#macro _plus(NUM1,NUM2)
  Do 
Macro_answer=""
_two=""
 #macro finish(x)
  Macro_answer=Ltrim(Macro_answer,"0")
        If Macro_answer="" Then
        Macro_answer="0"
        If swap_flag=1 Then Swap num1,num2
        swap_flag=0
        Endif
       Exit Do
 #endmacro
 num1_length=Len(NUM1)
 num2_length=Len(NUM2)
 If num2_length>num1_length Then
 Swap NUM2,NUM1
 Swap num2_length,num1_length
 swap_flag=1
 Endif

         diff=num1_length-num2_length-Sgn(num1_length-num2_length)
        Macro_answer="0"+NUM1
        _two=String(num1_length-num2_length,"0")+NUM2
        carry_over=zero
         For _z=num1_length-1 To diff Step -1
          carry_under=_two[_z]+NUM1[_z]-ninetysix
            Macro_answer[_z+1]=add_Qmod(carry_under+carry_over)
            carry_over=add_bool(carry_under+carry_over)
        Next _z
        If carry_over=zero Then
        finish(0)
        Exit Do
        Endif
       
        If _z=-1 Then
        Macro_answer[0]=carry_over+fortyeight
         finish(0)
         Exit Do
        Endif
       'continue the loop to the bitter end if needed
        For _z=_z To 0 Step -1
             carry_under=_two[_z]+NUM1[_z]-ninetysix
               Macro_answer[_z+1]=add_Qmod(carry_under+carry_over)
            carry_over=add_bool(carry_under+carry_over)
        Next _z
        Macro_answer[0]=carry_over+fortyeight
    finish(0)
    Exit Do
    Loop
#endmacro

'new july 2010

#macro _minus(num1,num2)
        bigger=0
        num1_length=Len(NUM1)
        num2_length=Len(NUM2)
         #macro compare(numbers)
If num2_length>num1_length Then bigger= -1:Goto fin
    If num2_length<num1_length 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 num2_length,num1_length
swap_flag=1
Endif
       
         diff =num1_length-num2_length-Sgn(num1_length-num2_length)
       
        Macro_answer=NUM1
        _two=String(num1_length-num2_length,"0")+NUM2
       
        carry_over=0
        Do
         For _z=num1_length-1 To diff Step -1
           carry_under= NUM1[_z]-_two[_z]+ten-carry_over
           Macro_answer[_z]=sub_Qmod(carry_under)
            carry_over=sub_bool(carry_under)
        Next _z
        If carry_over=0 Then Exit Do
        If _z=-1 Then Exit Do
        For _z=_z To 0 Step -1
            carry_under= NUM1[_z]-_two[_z]+ten-carry_over
            Macro_answer[_z]=sub_Qmod(carry_under)
            carry_over=sub_bool(carry_under)
            Next _z
        Exit Do
        Loop
        Macro_answer=Ltrim(Macro_answer,"0")
        If Macro_answer="" Then Macro_answer="0"
        If swap_flag=1 Then Swap NUM1,NUM2
       macro_answer= sign+Macro_answer
#endmacro

'********************** END DODICAT'S MACROS ***********************
'DODICAT FLOAT ADD
function _add(number1 as string,number2 as string) as string
    dim as string s1,s2,zeros,answer
    s1=number1:s2=number2
    dim as long lendec1,lendec2,diff,decpos
    split(s1,".")
    lendec1=len(var2)
    s1=var1+var2
    split(s2,".")
    lendec2=len(var2)
    s2=var1+var2
   diff=abs(lendec1-lendec2)
    zeros=string(diff,"0")
     decpos=lendec1
     if lendec1>lendec2 then
     s2=s2+zeros
     decpos=lendec1
     end if
     if lendec2>lendec1 then
     s1=s1+zeros
     decpos=lendec2
 end if
     _plus(s1,s2)
     s1="":s2="":zeros="":var1="":var2=""
     answer=macro_answer
     decpos=len(answer)-decpos
     insert(macro_answer,".",decpos+1)
     _add=macro_answer
     macro_answer=""
end function

'ALBERT'S ADD
Function add(n1 As String,n2 As String) As String
    Dim As String num1 = n1 ,num2 = n2
    Dim As Ulongint len1,len2
    Dim As String answer
    Dim As Integer carry
    Dim As Integer val1,val2,tot
   
    Dim As String int1,frac1
    Dim As String int2,frac2
    Dim As Ulongint dec1,dec2
   
    dec1=Instr(1,num1,".")
    If dec1 >= 1 Then
        int1=Left(num1,dec1-1)
        frac1=Mid(num1,dec1+1)
    Else
        int1 = num1
        frac1=""
    End If
   
    dec2=Instr(1,num2,".")
    If dec2 >= 1 Then
        int2=Left(num2,dec2-1)
        frac2=Mid(num2,dec2+1)
    Else
        int2 = num2
        frac2=""
    End If
   
   
    If Len(int1)<len(int2) Then int1 = int1 + String(Len(int2)-Len(int1),"0")
    If Len(int2)<len(int1) Then int2 = int2 + String(Len(int1)-Len(int2),"0")
    If Len(frac1)<len(frac2) Then frac1 = frac1 + String(Len(frac2)-Len(frac1),"0")
    If Len(frac2)<len(frac1) Then frac2 = frac2 + String(Len(frac1)-Len(frac2),"0")
   
    num1=int1+"."+frac1
    num2=int2+"."+frac2

    len1=Len(num1)
    len2=Len(num2)
   
    answer = String(len1,"0")
    carry=0
   
    Dim As Ulongint l1,l2,la
    l1=Len(num1)-1
    l2=Len(num2)-1
    la=Len(answer)-1
   
    Dim As Ubyte Ptr pt1,pt2,pta
    pt1 = cptr(Ubyte Ptr , Strptr(num1))+l1
    pt2 = cptr(Ubyte Ptr , Strptr(num2))+l2
    pta = cptr(Ubyte Ptr , Strptr(answer))+la

    For a As Integer = len1-1 To 0 Step -1
        val1=*pt1-48
        val2=*pt2-48
        If val2>=0 Then
            tot = (val1)+(val2)+carry+48
            carry=0
            If tot >=58 Then
                carry=1
                *pta = tot-10
            Else
                *pta = tot
            End If
        Else
            *pta=46
        End If
        pt1-=1
        pt2-=1
        pta-=1
    Next
   
    If carry>0 Then answer=Str(carry)+answer
   
    Return answer
End Function   
Function subtract(n1 As String,n2 As String) As String
    Dim As String num1 = n1 ,num2 = n2
    Dim As Ulongint len1,len2
    Dim As String answer
    Dim As Integer borrow,carry
    Dim As Integer val1,val2,tot
   
    Dim As String int1,frac1
    Dim As String int2,frac2
    Dim As Ulongint dec1,dec2
   
    dec1=Instr(1,num1,".")
    If dec1 >= 1 Then
        int1=Left(num1,dec1-1)
        frac1=Mid(num1,dec1+1)
    Else
        int1 = num1
        frac1=""
    End If
   
    dec2=Instr(1,num2,".")
    If dec2 >= 1 Then
        int2=Left(num2,dec2-1)
        frac2=Mid(num2,dec2+1)
    Else
        int2 = num2
        frac2=""
    End If
   
    If Len(int1)<len(int2) Then int1 = int1 + String(Len(int2)-Len(int1),"0")
    If Len(int2)<len(int1) Then int2 = int2 + String(Len(int1)-Len(int2),"0")
    If Len(frac1)<len(frac2) Then frac1 = frac1 + String(Len(frac2)-Len(frac1),"0")
    If Len(frac2)<len(frac1) Then frac2 = frac2 + String(Len(frac1)-Len(frac2),"0")
   
    num1=int1+"."+frac1
    num2=int2+"."+frac2

    len1=Len(num1)
    len2=Len(num2)

    'put larger number on top
    Dim As Ulongint count
    count = 0
    Do
        val1 = num1[count]
        val2 = num2[count]
   
        If val1 > val2 Then Exit Do
        If val2 > val1 Then Swap num1,num2:Exit Do
   
        count = count + 1
   
    Loop Until count=len1
   
    answer = String(len1,"0")
    borrow=0
    carry=0
   
    Dim As Ulongint l1,l2,la
    l1=Len(num1)-1
    l2=Len(num2)-1
    la=Len(answer)-1
   
    Dim As Ubyte Ptr pt1,pt2,pta
    pt1 = cptr(Ubyte Ptr , Strptr(num1))+l1
    pt2 = cptr(Ubyte Ptr , Strptr(num2))+l2
    pta = cptr(Ubyte Ptr , Strptr(answer))+la

    For a As Integer = len1-1 To 0 Step -1
        val1=*pt1-48
        val2=*pt2-48
        If val1=-2 Then
            *pta=46
        Else   
            If borrow = 1 Then If val1 > 0 Then val1-= borrow : borrow = 0 Else val1=9
            If val1 < val2 Then val1 += 10 : borrow = 1
            *pta = val1-val2+48
        End If
       
        pt1-=1
        pt2-=1
        pta-=1
    Next

    Return answer
End Function   
'***************************************************
Dim As String n1,n2,answer1,answer2
Dim As Double ts1,te1,tt1
Dim As Double ts2,te2,tt2

Print "Press space to start, then no other key"
Sleep
Print "building  two 2000000 digit numbers, please wait"
Do
    'setup number 1
    n1=""
    For a As Integer = 1 To 2000000'0
        n1=n1+Chr(Rnd*9+48)
    Next
    n1=n1+"."
    For a As Integer = 1 To 10
        n1=n1+Chr(Rnd*9+48)
    Next
   
    'setup number 2
    n2=""
    For a As Integer = 1 To 2000000'0
        n2=n2+Chr(Rnd*9+48)
    Next
    n2=n2+"."
    For a As Integer = 1 To 10
        n2=n2+Chr(Rnd*9+48)
    Next

   
    'print n1
    'print
    'print n2
    'print
   
    ts1=Timer
    answer1=add(n1,n2)
    te1=Timer
    tt1=te1-ts1
   ' print answer1
   
    ts2=Timer
    '_plus(n1,n2)
    answer2=_add(n1,n2)
    te2=Timer
    tt2=te2-ts2
   ' print answer2
    Print "Albert  "; tt1
    Print "Dodicat ";tt2
    Dim answer3 As String
   
answer3= subtract(answer1,answer2)
    if instr(answer3,".") then
       answer3= ltrim(answer3,"0")
        answer3=rtrim(answer3,"0")
        end if
    Print
    Print "Albert answer - Dodicat answer = ";answer3
    Print "Press esc to quit or space for another"
    If Inkey =" " Then Sleep
   
    If Inkey = Chr(27) Then End
Print "continuing, press spacebar now if you want to quit next time round"
Loop

Sleep

End


 



[dodicat]

Hi Albert
I've got a positive float _add and _subtract done.
I've went back to functions instead of macros.
The only stuff outside the functions are the look up tables and a split string and insert point macro.
I might even put these back inside to tidy things up.
I've done a subtraction comparison, yours and mine, and a subtraction test at the end.

Code: Select all

   
   
   'look up tables
            Dim shared ADDQmod(0 To 19) as ubyte
            Dim shared ADDbool(0 To 19) As Ubyte
            Dim shared SUBQmod(0 To 19) as ubyte
            Dim shared SUBbool(0 To 19) As Ubyte
For z As Integer=0 To 19
    ADDQmod(z)=cubyte(z Mod 10+48)
    ADDbool(z)=cubyte(-(10<=z))
    SUBQmod(z)=cubyte(z Mod 10+48)
    SUBbool(z)=cubyte(-(10>z))
Next z

#macro insertpoint(s,char,position)
scope
if position>0 and position<=len(s) then
 dim as string part1=Mid$(s,1,position-1)
 dim as string part2=Mid$(s,position)
 s=part1+char+part2
end if
end scope
 #endmacro
 
    #macro split(stri,char,var1,var2)
    scope
    dim as long pst=Instr(stri,char)
    var1="":var2=""
    If pst<>0 Then
    var1=Mid(stri,1,pst-1)
    var2=Mid(stri,pst+1)
Else
    var1=stri
    Endif
    end scope
    #endmacro
 'dodicat integer add 
Function plus(NUM1 As String,NUM2 As String) As String
        Dim As Byte flag
 #macro finish(three)
  three=Ltrim(three,"0")
        If three="" Then Return "0"
       If flag=1 Then Swap NUM2,NUM1
       Return three
       Exit Function
 #endmacro
 dim as long lenf=Len(NUM1)
 dim as long lens=Len(NUM2)
 If lens>lenf Then
 Swap NUM2,NUM1
 Swap lens,lenf
 flag=1
 Endif

        Dim diff As Long=lenf-lens-Sgn(lenf-lens)
       dim as string three="0"+NUM1
       dim as string two=String(lenf-lens,"0")+NUM2
        Dim As Long n2
        Dim As Ubyte addup,addcarry
        Dim As Ubyte ten=10
        Dim As Ubyte ninetysix=96
        Dim As Ubyte fortyeight=48
        Dim As Ubyte zero=0
        addcarry=zero
           
         For n2=lenf-1 To diff Step -1
          addup=two[n2]+NUM1[n2]-ninetysix
            three[n2+1]=ADDQmod(addup+addcarry)
            addcarry=ADDbool(addup+addcarry)
        Next n2
       
        If addcarry=zero Then
        finish(three)
        Endif
        If n2=-1 Then
        three[0]=addcarry+fortyeight
         finish(three)
        Endif

        For n2=n2 To 0 Step -1
             addup=two[n2]+NUM1[n2]-ninetysix
               three[n2+1]=ADDQmod(addup+addcarry)
            addcarry=ADDbool(addup+addcarry)
        Next n2
        three[0]=addcarry+fortyeight
    finish(three)
End Function
'dodicat integer subtract
Function minus(NUM1 As String,NUM2 As String) As String
   
        Dim As Byte swapflag           
        Dim sign As String * 1
        Dim bigger As Byte
      dim as long  lenf=Len(NUM1)
      dim as long  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
       
        Dim diff As Long=lenf-lens-Sgn(lenf-lens)
       ' dim as string one,two,three
        dim as string three=NUM1
       dim as string  two=String(lenf-lens,"0")+NUM2
        dim as string one=NUM1
        Dim As Long n2
        Dim As Ubyte takeaway,subtractcarry
        Dim As Ubyte ten=10
        subtractcarry=0
        Do
         For n2=lenf-1 To diff Step -1
           takeaway= one[n2]-two[n2]+ten-subtractcarry
           three[n2]=SUBQmod(takeaway)
            subtractcarry=SUBbool(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]=SUBQmod(takeaway)
            subtractcarry=SUBbool(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
'dodicat positive float add
function _add(number1 as string,number2 as string) as string
       'dim  as string part1,part2

dim  as string var1,var2
   dim as string s1=number1:dim as string s2=number2
    split(s1,".",var1,var2)
   dim as long lendec1=len(var2)
    s1=var1+var2
    split(s2,".",var1,var2)
   dim as long lendec2=len(var2)
    s2=var1+var2
  dim as long diff=abs(lendec1-lendec2)
   dim as string zeros=string(diff,"0")
    dim as long decpos=lendec1
     if lendec1>lendec2 then
     s2=s2+zeros
     decpos=lendec1
     end if
     if lendec2>lendec1 then
     s1=s1+zeros
     decpos=lendec2
 end if
   dim as string answer=plus(s1,s2)
     decpos=len(answer)-decpos
     insertpoint(answer,".",decpos+1)
     function=answer
end function
'dodicat positive float subtract
function _subtract(number1 as string,number2 as string) as string
       'dim  as string part1,part2
dim  as string var1,var2
   dim as string s1=number1:dim as string s2=number2
    split(s1,".",var1,var2)
   dim as long lendec1=len(var2)
    s1=var1+var2
    split(s2,".",var1,var2)
   dim as long lendec2=len(var2)
    s2=var1+var2
  dim as long diff=abs(lendec1-lendec2)
   dim as string zeros=string(diff,"0")
    dim as long decpos=lendec1
   
     if lendec1>lendec2 then
     s2=s2+zeros
     decpos=lendec1
     end if
     if lendec2>lendec1 then
     s1=s1+zeros
     decpos=lendec2
 end if
 
   dim as string answer=minus(s1,s2)
   dim sign as string*1
   if left(answer,1)="-" then
   sign="-"
   answer=ltrim(answer,"-")
end if

if len(answer)< decpos then
    do
        answer="0"+answer
    loop until len(answer) = decpos
    answer=rtrim(answer,"0")
    answer=rtrim(answer,".")
    if answer="" then return"0"
    return sign+"."+answer
end if

     decpos=len(answer)-decpos
     insertpoint(answer,".",decpos+1)
     return sign+answer
end function


'ALBERT'S ADD
Function add(n1 As String,n2 As String) As String
    Dim As String num1 = n1 ,num2 = n2
    Dim As Ulongint len1,len2
    Dim As String answer
    Dim As Integer carry
    Dim As Integer val1,val2,tot
   
    Dim As String int1,frac1
    Dim As String int2,frac2
    Dim As Ulongint dec1,dec2
   
    dec1=Instr(1,num1,".")
    If dec1 >= 1 Then
        int1=Left(num1,dec1-1)
        frac1=Mid(num1,dec1+1)
    Else
        int1 = num1
        frac1=""
    End If
   
    dec2=Instr(1,num2,".")
    If dec2 >= 1 Then
        int2=Left(num2,dec2-1)
        frac2=Mid(num2,dec2+1)
    Else
        int2 = num2
        frac2=""
    End If
   
   
    If Len(int1)<len(int2) Then int1 = int1 + String(Len(int2)-Len(int1),"0")
    If Len(int2)<len(int1) Then int2 = int2 + String(Len(int1)-Len(int2),"0")
    If Len(frac1)<len(frac2) Then frac1 = frac1 + String(Len(frac2)-Len(frac1),"0")
    If Len(frac2)<len(frac1) Then frac2 = frac2 + String(Len(frac1)-Len(frac2),"0")
   
    num1=int1+"."+frac1
    num2=int2+"."+frac2

    len1=Len(num1)
    len2=Len(num2)
   
    answer = String(len1,"0")
    carry=0
   
    Dim As Ulongint l1,l2,la
    l1=Len(num1)-1
    l2=Len(num2)-1
    la=Len(answer)-1
   
    Dim As Ubyte Ptr pt1,pt2,pta
    pt1 = cptr(Ubyte Ptr , Strptr(num1))+l1
    pt2 = cptr(Ubyte Ptr , Strptr(num2))+l2
    pta = cptr(Ubyte Ptr , Strptr(answer))+la

    For a As Integer = len1-1 To 0 Step -1
        val1=*pt1-48
        val2=*pt2-48
        If val2>=0 Then
            tot = (val1)+(val2)+carry+48
            carry=0
            If tot >=58 Then
                carry=1
                *pta = tot-10
            Else
                *pta = tot
            End If
        Else
            *pta=46
        End If
        pt1-=1
        pt2-=1
        pta-=1
    Next
   
    If carry>0 Then answer=Str(carry)+answer
   
    Return answer
End Function
'ALBERT SUBTRACT
Function subtract(n1 As String,n2 As String) As String
    Dim As String num1 = n1 ,num2 = n2
    Dim As Ulongint len1,len2
    Dim As String answer
    Dim As Integer borrow,carry
    Dim As Integer val1,val2,tot
   
    Dim As String int1,frac1
    Dim As String int2,frac2
    Dim As Ulongint dec1,dec2
   
    dec1=Instr(1,num1,".")
    If dec1 >= 1 Then
        int1=Left(num1,dec1-1)
        frac1=Mid(num1,dec1+1)
    Else
        int1 = num1
        frac1=""
    End If
   
    dec2=Instr(1,num2,".")
    If dec2 >= 1 Then
        int2=Left(num2,dec2-1)
        frac2=Mid(num2,dec2+1)
    Else
        int2 = num2
        frac2=""
    End If
   
    If Len(int1)<len(int2) Then int1 = int1 + String(Len(int2)-Len(int1),"0")
    If Len(int2)<len(int1) Then int2 = int2 + String(Len(int1)-Len(int2),"0")
    If Len(frac1)<len(frac2) Then frac1 = frac1 + String(Len(frac2)-Len(frac1),"0")
    If Len(frac2)<len(frac1) Then frac2 = frac2 + String(Len(frac1)-Len(frac2),"0")
   
    num1=int1+"."+frac1
    num2=int2+"."+frac2

    len1=Len(num1)
    len2=Len(num2)

    'put larger number on top
    Dim As Ulongint count
    count = 0
    Do
        val1 = num1[count]
        val2 = num2[count]
   
        If val1 > val2 Then Exit Do
        If val2 > val1 Then Swap num1,num2:Exit Do
   
        count = count + 1
   
    Loop Until count=len1
   
    answer = String(len1,"0")
    borrow=0
    carry=0
   
    Dim As Ulongint l1,l2,la
    l1=Len(num1)-1
    l2=Len(num2)-1
    la=Len(answer)-1
   
    Dim As Ubyte Ptr pt1,pt2,pta
    pt1 = cptr(Ubyte Ptr , Strptr(num1))+l1
    pt2 = cptr(Ubyte Ptr , Strptr(num2))+l2
    pta = cptr(Ubyte Ptr , Strptr(answer))+la

    For a As Integer = len1-1 To 0 Step -1
        val1=*pt1-48
        val2=*pt2-48
        If val1=-2 Then
            *pta=46
        Else   
            If borrow = 1 Then If val1 > 0 Then val1-= borrow : borrow = 0 Else val1=9
            If val1 < val2 Then val1 += 10 : borrow = 1
            *pta = val1-val2+48
        End If
       
        pt1-=1
        pt2-=1
        pta-=1
    Next

    Return answer
End Function   

Dim As String n1,n2,answer1,answer2
Dim As Double ts1,te1,tt1
Dim As Double ts2,te2,tt2

Print "Press space to start, then no other key"
Sleep
Print "building  two 2000000 digit numbers, please wait"
Do
    'setup number 1
    n1=""
    For a As Integer = 1 To 2000000'0
        n1=n1+Chr(Rnd*9+48)
    Next
    n1=n1+"."
    For a As Integer = 1 To 10
        n1=n1+Chr(Rnd*9+48)
    Next
   
    'setup number 2
    n2=""
    For a As Integer = 1 To 2000000'0
        n2=n2+Chr(Rnd*9+48)
    Next
    n2=n2+"."
    For a As Integer = 1 To 10
        n2=n2+Chr(Rnd*9+48)
    Next

   
    'print n1
    'print
    'print n2
    'print
   
    ts1=Timer
    answer1=subtract(n1,n2)
    te1=Timer
    tt1=te1-ts1
   ' print answer1
   
    ts2=Timer
    '_plus(n1,n2)
    answer2=_subtract(n1,n2)'''''
    te2=Timer
    tt2=te2-ts2
   ' print answer2
    Print "Albert  "; tt1
    Print "Dodicat ";tt2
    'Dim answer3 As String
   
'answer3= subtract(answer1,answer2)
    'if instr(answer3,".") then
       'answer3= ltrim(answer3,"0")
       ' answer3=rtrim(answer3,"0")
        'end if
    Print
   
    Print "Dodicat subtract answer1 - answer2 = ";left(_subtract(answer1,answer2),20)
    Print "Albert subtract answer1 - answer2 = ";left(subtract(answer1,answer2),20)
    Print "Press esc to quit or space for another"
    If Inkey =" " Then Sleep
   
    If Inkey = Chr(27) Then Exit do
Print "continuing, press spacebar now if you want to quit next time round"
Loop

print "Press a key"
sleep


randomize
Function r(first As Double, last As Double) As Double
    Function = Rnd * (last - first) + first
End Function
'Testing dodicat's subtract
print "Test dodicat 500 subtractions"
for z as integer=1 to 500
n1=str(r(1,500))
n2=str(r(1,500))
answer1=_subtract(n1,n2)
if val(n1)-val(n2)-val(answer1)>1e-6 then
     print n1,n2
    print val(n1)-val(n2),val(answer1)
    end if
'print n1,n2
next z
print "DODICAT done"

'Testing ALBERT'S subtract
print "Test Albert 500 subtractions"
for z as integer=1 to 500
n1=str(r(1,500))
n2=str(r(1,500))
answer1=subtract(n1,n2)
if val(n1)-val(n2)-val(answer1)>1e-6 then
    print n1,n2
    print val(n1)-val(n2),val(answer1)
    end if
next z
print "ALBERT done"

print _subtract("468.8721769042313","5.807500198949128")
print subtract("468.8721769042313","5.807500198949128")
Sleep

End


 


[albert]

@Dodicat

My subtract function puts the bigger number on top, and neither one currently works with signs (+-)

I'm going to put them together with a common analyzer function that you call instead of add/subtract. ans the analyzer function will do the necessary swaping of bigger/smaller and call the appropiate add/subtract function.

[anonymous1337]

Speaking of squares:

Code: Select all

'' Solving Fermat's Two Square Theorem for Prime Integers
''
'' Theorem:  c^2 can be partitioned into the a^2 + b^2 where
''    a and b are both integers, for prime integers c if and
''    only if c = 1 (modulus 4)
''
'' This is not a proof of the theorem.
'' It only displays solutions.
''
'' Solution:
''    Let a, b and c be any positive integers
''    For constant c,
''    Let a be the independent variable for the solution
''    Let b be the dependent variable for the solution
''
''    a^2 + b^2 = c^2
''    b^2 = c^2 - a^2
''    b = sqrt(c^2 - a^2)
''
''    Iterating a, solve for b until it is an integer.
''    Then a^2 + b^2 must be equivalent to c^2 and both
''    a and b must be integers.  The solution is valid.

dim as uInteger solutions = 0
dim as double begin

print "Hit any key to begin."
sleep
begin = timer()

/'
 ' Method 1:  Using modular division, as described above.
 '/
for c as uInteger = 0 to 20000
   
    '' Potentially partitionable
    if( (c mod 4) = 1 ) then
       
        '' Iterate through all possible a
        for a as uInteger = 1 to c - 1
           
            '' Solve for b
            dim b as integer = sqr(c*c - a*a)
           
            '' Solve for a and b as integers since b is implicitly converted to one
            if( a^2 + b^2 = c^2 ) then
                print "Solution: a = " & a & ", b = " & b & ", c = " & c
                solutions += 1
                exit for
            end if
           
        next
       
    end if
   
next
print "Total solutions found: " & solutions
print "Total time taken: " & timer() - begin
solutions = 0
sleep
begin = timer()
 
/'
 ' Method 2:  Using an equivalent form to iterate more quickly
 '     through possible values.  Form for potential prime
 '     solutions is c = 4n + 1
 '/
for n as uInteger = 0 to 5000 - 1
   
    '' c = 4n + 1 gives every case for c = 1 modulus 4
    '' thus c is always potentially partitionable
    dim as uInteger c = 4*n + 1
   
    '' Iterate through all possible a
    for a as uInteger = 1 to c - 1
       
        '' Solve for b
        dim b as integer = sqr(c*c - a*a)
       
        '' Solve for a and b as integers since b is implicitly converted to one
        if( a^2 + b^2 = c^2 ) then
            print "Solution: a = " & a & ", b = " & b & ", c = " & c
            solutions += 1
            exit for
        end if
       
    next
   
next
print "Total solutions found: " & solutions
print "Total time taken: " & timer() - begin
solutions = 0
sleep

[albert]

@Dodicat
SORRY! I had:


If Len(int1)<len(int2) Then int1 = int1 + String(Len(int2)-Len(int1),"0")

instead of:

If Len(int1)<len(int2) Then int1 = String(Len(int2)-Len(int1),"0") + int1

Here is the corrected code:

Code: Select all




Function subtract(n1 As String,n2 As String) As String
    Dim As String num1 = n1 ,num2 = n2
    Dim As Ulongint len1,len2
    Dim As String answer
    Dim As Integer borrow,carry
    Dim As Integer val1,val2,tot
   
    Dim As String int1,frac1
    Dim As String int2,frac2
    Dim As Ulongint dec1,dec2
   
    dec1=Instr(1,num1,".")
    If dec1 >= 1 Then
        int1=Left(num1,dec1-1)
        frac1=Mid(num1,dec1+1)
    Else
        int1 = num1
        frac1=""
    End If
   
    dec2=Instr(1,num2,".")
    If dec2 >= 1 Then
        int2=Left(num2,dec2-1)
        frac2=Mid(num2,dec2+1)
    Else
        int2 = num2
        frac2=""
    End If
   
    If Len(int1)<len(int2) Then int1 = String(Len(int2)-Len(int1),"0") + int1
    If Len(int2)<len(int1) Then int2 = String(Len(int1)-Len(int2),"0") + int2
    If Len(frac1)<len(frac2) Then frac1 = frac1 + String(Len(frac2)-Len(frac1),"0")
    If Len(frac2)<len(frac1) Then frac2 = frac2 + String(Len(frac1)-Len(frac2),"0")
   
    num1=int1+"."+frac1
    num2=int2+"."+frac2

    len1=Len(num1)
    len2=Len(num2)

    'put larger number on top
    Dim As Ulongint count
    count = 0
    Do
        val1 = num1[count]
        val2 = num2[count]
   
        If val1 > val2 Then Exit Do
        If val2 > val1 Then Swap num1,num2:Exit Do
   
        count = count + 1
   
    Loop Until count=len1
   
    answer = String(len1,"0")
    borrow=0
    carry=0
   
    Dim As Ulongint l1,l2,la
    l1=Len(num1)-1
    l2=Len(num2)-1
    la=Len(answer)-1
   
    Dim As Ubyte Ptr pt1,pt2,pta
    pt1 = cptr(Ubyte Ptr , Strptr(num1))+l1
    pt2 = cptr(Ubyte Ptr , Strptr(num2))+l2
    pta = cptr(Ubyte Ptr , Strptr(answer))+la

    For a As Integer = len1-1 To 0 Step -1
        val1=*pt1-48
        val2=*pt2-48
        If val1=-2 Then
            *pta=46
        Else   
            If borrow = 1 Then If val1 > 0 Then val1-= borrow : borrow = 0 Else val1=9
            If val1 < val2 Then val1 += 10 : borrow = 1
            *pta = val1-val2+48
        End If
       
        pt1-=1
        pt2-=1
        pta-=1
    Next

    Return answer
End Function   
'***
Dim As String s1,s2,s3
s1="123456"
s2="1"
s3=subtract(s1,s2)
Print s1;"  -  ";s2
Print s3
Sleep



[dodicat]

Speaking of squares:

Thanks anonymous1337.
Fermat, having been a lawer, you would think would have been an expert at proving things.
However, the margins on his papers were usually conveniently too narrow to scribble down the proof of his mathematical conjectures.
I wonder how his clients fared in court, with non mathematical proofs.

[dodicat]

@Dodicat
SORRY! I had:


If Len(int1)<len(int2) Then int1 = int1 + String(Len(int2)-Len(int1),"0")

instead of:

If Len(int1)<len(int2) Then int1 = String(Len(int2)-Len(int1),"0") + int1

Here is the corrected code:

Hi Albert
I've stuck your new subtract into the test.
Still seems to be a problem if the second number is bigger than the first.

Code: Select all

   
   
   'look up tables
            Dim shared ADDQmod(0 To 19) as ubyte
            Dim shared ADDbool(0 To 19) As Ubyte
            Dim shared SUBQmod(0 To 19) as ubyte
            Dim shared SUBbool(0 To 19) As Ubyte
For z As Integer=0 To 19
    ADDQmod(z)=cubyte(z Mod 10+48)
    ADDbool(z)=cubyte(-(10<=z))
    SUBQmod(z)=cubyte(z Mod 10+48)
    SUBbool(z)=cubyte(-(10>z))
Next z

#macro insertpoint(s,char,position)
scope
if position>0 and position<=len(s) then
 dim as string part1=Mid$(s,1,position-1)
 dim as string part2=Mid$(s,position)
 s=part1+char+part2
end if
end scope
 #endmacro
 
    #macro split(stri,char,var1,var2)
    scope
    dim as long pst=Instr(stri,char)
    var1="":var2=""
    If pst<>0 Then
    var1=Mid(stri,1,pst-1)
    var2=Mid(stri,pst+1)
Else
    var1=stri
    Endif
    end scope
    #endmacro
 'dodicat integer add 
Function plus(NUM1 As String,NUM2 As String) As String
        Dim As Byte flag
 #macro finish(three)
  three=Ltrim(three,"0")
        If three="" Then Return "0"
       If flag=1 Then Swap NUM2,NUM1
       Return three
       Exit Function
 #endmacro
 dim as long lenf=Len(NUM1)
 dim as long lens=Len(NUM2)
 If lens>lenf Then
 Swap NUM2,NUM1
 Swap lens,lenf
 flag=1
 Endif

        Dim diff As Long=lenf-lens-Sgn(lenf-lens)
       dim as string three="0"+NUM1
       dim as string two=String(lenf-lens,"0")+NUM2
        Dim As Long n2
        Dim As Ubyte addup,addcarry
        Dim As Ubyte ten=10
        Dim As Ubyte ninetysix=96
        Dim As Ubyte fortyeight=48
        Dim As Ubyte zero=0
        addcarry=zero
           
         For n2=lenf-1 To diff Step -1
          addup=two[n2]+NUM1[n2]-ninetysix
            three[n2+1]=ADDQmod(addup+addcarry)
            addcarry=ADDbool(addup+addcarry)
        Next n2
       
        If addcarry=zero Then
        finish(three)
        Endif
        If n2=-1 Then
        three[0]=addcarry+fortyeight
         finish(three)
        Endif

        For n2=n2 To 0 Step -1
             addup=two[n2]+NUM1[n2]-ninetysix
               three[n2+1]=ADDQmod(addup+addcarry)
            addcarry=ADDbool(addup+addcarry)
        Next n2
        three[0]=addcarry+fortyeight
    finish(three)
End Function
'dodicat integer subtract
Function minus(NUM1 As String,NUM2 As String) As String
   
        Dim As Byte swapflag           
        Dim sign As String * 1
        Dim bigger As Byte
      dim as long  lenf=Len(NUM1)
      dim as long  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
       
        Dim diff As Long=lenf-lens-Sgn(lenf-lens)
       ' dim as string one,two,three
        dim as string three=NUM1
       dim as string  two=String(lenf-lens,"0")+NUM2
        dim as string one=NUM1
        Dim As Long n2
        Dim As Ubyte takeaway,subtractcarry
        Dim As Ubyte ten=10
        subtractcarry=0
        Do
         For n2=lenf-1 To diff Step -1
           takeaway= one[n2]-two[n2]+ten-subtractcarry
           three[n2]=SUBQmod(takeaway)
            subtractcarry=SUBbool(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]=SUBQmod(takeaway)
            subtractcarry=SUBbool(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
'dodicat positive float add
function _add(number1 as string,number2 as string) as string
       'dim  as string part1,part2

dim  as string var1,var2
   dim as string s1=number1:dim as string s2=number2
    split(s1,".",var1,var2)
   dim as long lendec1=len(var2)
    s1=var1+var2
    split(s2,".",var1,var2)
   dim as long lendec2=len(var2)
    s2=var1+var2
  dim as long diff=abs(lendec1-lendec2)
   dim as string zeros=string(diff,"0")
    dim as long decpos=lendec1
     if lendec1>lendec2 then
     s2=s2+zeros
     decpos=lendec1
     end if
     if lendec2>lendec1 then
     s1=s1+zeros
     decpos=lendec2
 end if
   dim as string answer=plus(s1,s2)
     decpos=len(answer)-decpos
     insertpoint(answer,".",decpos+1)
     function=answer
end function
'dodicat positive float subtract
function _subtract(number1 as string,number2 as string) as string
       'dim  as string part1,part2
dim  as string var1,var2
   dim as string s1=number1:dim as string s2=number2
    split(s1,".",var1,var2)
   dim as long lendec1=len(var2)
    s1=var1+var2
    split(s2,".",var1,var2)
   dim as long lendec2=len(var2)
    s2=var1+var2
  dim as long diff=abs(lendec1-lendec2)
   dim as string zeros=string(diff,"0")
    dim as long decpos=lendec1
   
     if lendec1>lendec2 then
     s2=s2+zeros
     decpos=lendec1
     end if
     if lendec2>lendec1 then
     s1=s1+zeros
     decpos=lendec2
 end if
 
   dim as string answer=minus(s1,s2)
   dim sign as string*1
   if left(answer,1)="-" then
   sign="-"
   answer=ltrim(answer,"-")
end if

if len(answer)< decpos then
    do
        answer="0"+answer
    loop until len(answer) = decpos
    answer=rtrim(answer,"0")
    answer=rtrim(answer,".")
    if answer="" then return"0"
    return sign+"."+answer
end if

     decpos=len(answer)-decpos
     insertpoint(answer,".",decpos+1)
     return sign+answer
end function


'ALBERT'S ADD
Function add(n1 As String,n2 As String) As String
    Dim As String num1 = n1 ,num2 = n2
    Dim As Ulongint len1,len2
    Dim As String answer
    Dim As Integer carry
    Dim As Integer val1,val2,tot
   
    Dim As String int1,frac1
    Dim As String int2,frac2
    Dim As Ulongint dec1,dec2
   
    dec1=Instr(1,num1,".")
    If dec1 >= 1 Then
        int1=Left(num1,dec1-1)
        frac1=Mid(num1,dec1+1)
    Else
        int1 = num1
        frac1=""
    End If
   
    dec2=Instr(1,num2,".")
    If dec2 >= 1 Then
        int2=Left(num2,dec2-1)
        frac2=Mid(num2,dec2+1)
    Else
        int2 = num2
        frac2=""
    End If
   
   
    If Len(int1)<len(int2) Then int1 = int1 + String(Len(int2)-Len(int1),"0")
    If Len(int2)<len(int1) Then int2 = int2 + String(Len(int1)-Len(int2),"0")
    If Len(frac1)<len(frac2) Then frac1 = frac1 + String(Len(frac2)-Len(frac1),"0")
    If Len(frac2)<len(frac1) Then frac2 = frac2 + String(Len(frac1)-Len(frac2),"0")
   
    num1=int1+"."+frac1
    num2=int2+"."+frac2

    len1=Len(num1)
    len2=Len(num2)
   
    answer = String(len1,"0")
    carry=0
   
    Dim As Ulongint l1,l2,la
    l1=Len(num1)-1
    l2=Len(num2)-1
    la=Len(answer)-1
   
    Dim As Ubyte Ptr pt1,pt2,pta
    pt1 = cptr(Ubyte Ptr , Strptr(num1))+l1
    pt2 = cptr(Ubyte Ptr , Strptr(num2))+l2
    pta = cptr(Ubyte Ptr , Strptr(answer))+la

    For a As Integer = len1-1 To 0 Step -1
        val1=*pt1-48
        val2=*pt2-48
        If val2>=0 Then
            tot = (val1)+(val2)+carry+48
            carry=0
            If tot >=58 Then
                carry=1
                *pta = tot-10
            Else
                *pta = tot
            End If
        Else
            *pta=46
        End If
        pt1-=1
        pt2-=1
        pta-=1
    Next
   
    If carry>0 Then answer=Str(carry)+answer
   
    Return answer
End Function
'ALBERT SUBTRACT
Function subtract(n1 As String,n2 As String) As String
    Dim As String num1 = n1 ,num2 = n2
    Dim As Ulongint len1,len2
    Dim As String answer
    Dim As Integer borrow,carry
    Dim As Integer val1,val2,tot
   
    Dim As String int1,frac1
    Dim As String int2,frac2
    Dim As Ulongint dec1,dec2
   
    dec1=Instr(1,num1,".")
    If dec1 >= 1 Then
        int1=Left(num1,dec1-1)
        frac1=Mid(num1,dec1+1)
    Else
        int1 = num1
        frac1=""
    End If
   
    dec2=Instr(1,num2,".")
    If dec2 >= 1 Then
        int2=Left(num2,dec2-1)
        frac2=Mid(num2,dec2+1)
    Else
        int2 = num2
        frac2=""
    End If
   
    If Len(int1)<len(int2) Then int1 = String(Len(int2)-Len(int1),"0") + int1
    If Len(int2)<len(int1) Then int2 = String(Len(int1)-Len(int2),"0") + int2
    If Len(frac1)<len(frac2) Then frac1 = frac1 + String(Len(frac2)-Len(frac1),"0")
    If Len(frac2)<len(frac1) Then frac2 = frac2 + String(Len(frac1)-Len(frac2),"0")
   
    num1=int1+"."+frac1
    num2=int2+"."+frac2

    len1=Len(num1)
    len2=Len(num2)

    'put larger number on top
    Dim As Ulongint count
    count = 0
    Do
        val1 = num1[count]
        val2 = num2[count]
   
        If val1 > val2 Then Exit Do
        If val2 > val1 Then Swap num1,num2:Exit Do
   
        count = count + 1
   
    Loop Until count=len1
   
    answer = String(len1,"0")
    borrow=0
    carry=0
   
    Dim As Ulongint l1,l2,la
    l1=Len(num1)-1
    l2=Len(num2)-1
    la=Len(answer)-1
   
    Dim As Ubyte Ptr pt1,pt2,pta
    pt1 = cptr(Ubyte Ptr , Strptr(num1))+l1
    pt2 = cptr(Ubyte Ptr , Strptr(num2))+l2
    pta = cptr(Ubyte Ptr , Strptr(answer))+la

    For a As Integer = len1-1 To 0 Step -1
        val1=*pt1-48
        val2=*pt2-48
        If val1=-2 Then
            *pta=46
        Else   
            If borrow = 1 Then If val1 > 0 Then val1-= borrow : borrow = 0 Else val1=9
            If val1 < val2 Then val1 += 10 : borrow = 1
            *pta = val1-val2+48
        End If
       
        pt1-=1
        pt2-=1
        pta-=1
    Next

    Return answer
End Function   
Dim As String n1,n2,answer1,answer2
Dim As Double ts1,te1,tt1
Dim As Double ts2,te2,tt2

Print "Press space to start, then no other key"
Sleep
Print "building  two 2000000 digit numbers, please wait"
Do
    'setup number 1
    n1=""
    For a As Integer = 1 To 2000000'0
        n1=n1+Chr(Rnd*9+48)
    Next
    n1=n1+"."
    For a As Integer = 1 To 10
        n1=n1+Chr(Rnd*9+48)
    Next
   
    'setup number 2
    n2=""
    For a As Integer = 1 To 3000000'0 'MADE THIS BIGGER
        n2=n2+Chr(Rnd*9+48)
    Next
    n2=n2+"."
    For a As Integer = 1 To 10
        n2=n2+Chr(Rnd*9+48)
    Next

   
    'print n1
    'print
    'print n2
    'print
   
    ts1=Timer
    answer1=subtract(n1,n2)
    te1=Timer
    tt1=te1-ts1
   ' print answer1
   
    ts2=Timer
    '_plus(n1,n2)
    answer2=_subtract(n1,n2)'''''
    te2=Timer
    tt2=te2-ts2
   ' print answer2
    Print "Albert  "; tt1
    Print "Dodicat ";tt2
    'Dim answer3 As String
   
'answer3= subtract(answer1,answer2)
    'if instr(answer3,".") then
       'answer3= ltrim(answer3,"0")
       ' answer3=rtrim(answer3,"0")
        'end if
    Print
   
    Print "Dodicat subtract answer1 - answer2 = ";left(_subtract(answer1,answer2),20)
    Print "Albert subtract answer1 - answer2 = ";left(subtract(answer1,answer2),20)
    Print "Press esc to quit or space for another"
    If Inkey =" " Then Sleep
   
    If Inkey = Chr(27) Then Exit do
Print "continuing, press spacebar now if you want to quit next time round"
Loop

print "Press a key"
sleep


randomize
Function r(first As Double, last As Double) As Double
    Function = Rnd * (last - first) + first
End Function
'Testing dodicat's subtract
print "Test dodicat 50 subtractions"
ts1=timer
for z as integer=1 to 50
n1=str(r(1,500000))
n2=str(r(1,500000))
answer1=_subtract(n1,n2)
if abs((val(n1)-val(n2))-val(answer1))>1e-6 then
     print n1,n2
    print val(n1)-val(n2),val(answer1)
    end if
'print n1,n2
next z
ts2=timer
print "DODICAT done time = ";ts2-ts1
print
'Testing ALBERT'S subtract
print "Test Albert 50 subtractions"
ts1=timer
for z as integer=1 to 50
n1=str(r(1,500000))
n2=str(r(1,500000))
answer1=subtract(n1,n2)
if abs((val(n1)-val(n2))-val(answer1))>1e-6 then
    print n1,n2
    print val(n1)-val(n2),val(answer1)
    end if
next z
ts2=timer
print "ALBERT done time = ";ts2-ts1

print _subtract("468.8721769042313","468.8721769042319")
print  subtract("468.8721769042313","468.8721769042319")
Sleep

End


 



[anonymous1337]

Thanks for the humor, dodicat.

Have in mind any other interesting properties of numbers I should know about? I'm doing independent research on number theory, but only at a very, very elementary level so far.

EDIT:

Hey, what's Fermat's Last Theorem's implications on triangles? Well no, what's Diophantus's viewpoint on this?

PSS: Argh, I'm trying to find algorithms for splitting triangles http://en.wikipedia.org/wiki/Orthocenter like that, where I'm guaranteed a 90 degree angle. (Trying this on my own, haven't read the wiki page.)

I really need graphing paper.

[albert]

@Dodicat

My subtractor function has a few lines of code in it to put the bigger number on top. so it always subtracts smaller from bigger.

I'm working on multiplying again, i'm bouncing around doing a little of this and a little of that and not getting a fully functional anything yet.its just part is parts , maybe i should finish one thing first before i move on to another.

I'm disapointed that they locked my circles thread,I don't see how my interpretations of biblical scripture was anti-semitic at most they should maybe have posted that my interpretations were not inline with jewish teachings.???? but never mind that. i'll have to use Richards squares.

[dodicat]

@Dodicat

My subtractor function has a few lines of code in it to put the bigger number on top. so it always subtracts smaller from bigger.

I'm working on multiplying again, i'm bouncing around doing a little of this and a little of that and not getting a fully functional anything yet.its just part is parts , maybe i should finish one thing first before i move on to another.

I'm disapointed that they locked my circles thread,I don't see how my interpretations of biblical scripture was anti-semitic at most they should maybe have posted that my interpretations were not inline with jewish teachings.???? but never mind that. i'll have to use Richards squares.

Hi Albert
I'm the same with bignumbers, but there's no deadline, it's just an ongoing topic for me, I'll get it done one of these days.

Religion is a touchy subject at the best of times, and there has been a dictionary of terrible names chucked about.
I suppose you did give a few members a chance to vent their fury but I daresay they are all settled down again.
As Rollie~ pointed out, there's been worse stuff in the forums, with a few trying to pull the con on us vulnerable souls.
Bfuller had a nice idea which he set out in the topic RICHARD, which has since gone walkabout.
Maybe he could re-explain the project, if he is about.

Hi anonymous1337
I havn't tried getting ortho-centres and drawing altitudes (YET).
I know that the incentre, orthocentre and centroid of a triangle all lie on the same line, so it shouldn't be too difficult, considering that the altitudes are normals to the sides.
In the meantime, if you like, here's an easy way to draw your triangles in cartesian co-ordinates within your chosen graph limits.
It saves you having to use window( ).
It's just a simple mapping, until you get some graph paper, and only the axis of the grid are shown.
Number theory is vast, quite often you have to enter the realm of bignumbers pretty quickly i.e. perfect numbers.

Code: Select all

dim as integer xres,yres
screeninfo xres,yres
screenres xres,yres,32

#macro drawline(x1,y1,x2,y2,minx,maxx,miny,maxy)
'axis
scope
if sgn(minx)<>sgn(maxx) then
    line(0,(yres-(miny/(miny-maxy))*yres))-(xres,(yres-(miny/(miny-maxy))*yres)),rgb(50,50,50) 'x axis
    endif
    if sgn(miny)<>sgn(maxy) then
        line(((minx/(minx-maxx))*xres),0)-(((minx/(minx-maxx))*xres),yres),rgb(50,50,50) 'y axis
        endif
        'line
      dim as double xx1= Cdbl(xres)*(x1-minx)/(maxx-minx)
       dim as double yy1=Cdbl(yres)*(y1-maxy)/(miny-maxy)
       dim as double xx2=Cdbl(xres)*(x2-minx)/(maxx-minx)
       dim as double yy2=Cdbl(yres)*(y2-maxy)/(miny-maxy)
       line(xx1,yy1)-(xx2,yy2),rgb(255,255,255)
       end scope
#endmacro
#macro _pset(x1,y1,minx,maxx,miny,maxy)
scope
   
'axis
if sgn(minx)<>sgn(maxx) then
    line(0,(yres-(miny/(miny-maxy))*yres))-(xres,(yres-(miny/(miny-maxy))*yres)),rgb(50,50,50) 'x axis
    endif
    if sgn(miny)<>sgn(maxy) then
        line(((minx/(minx-maxx))*xres),0)-(((minx/(minx-maxx))*xres),yres),rgb(50,50,50) 'y axis
        endif
        'point
      dim as double xx1= Cdbl(xres)*(x1-minx)/(maxx-minx)
       dim as double yy1=Cdbl(yres)*(y1-maxy)/(miny-maxy)
       circle(xx1,yy1),5,rgb(255,255,255),,,,f
       end scope
#endmacro
' ******************************************************************
dim as double lowerx,upperx,lowery,uppery
'define the cartesian limits(graph)
lowerx=-100
upperx=100
lowery=-100
uppery=100
dim as double x1,y1,x2,y2,x3,y3,centroidx,centroidy
'The three vertices of a triangle in the cartesian graph
x1=-20:y1=-20
x2=80:y2=20
x3=20:y3=-90
'The centroid
centroidx=(x1+x2+x3)/3
centroidy=(y1+y2+y3)/3
'DRAW THE TRIANGLE AND IT'S CENTROID
drawline(x1,y1,x2,y2,lowerx,upperx,lowery,uppery)
drawline(x2,y2,x3,y3,lowerx,upperx,lowery,uppery)
drawline(x3,y3,x1,y1,lowerx,upperx,lowery,uppery)
_pset(centroidx,centroidy,lowerx,upperx,lowery,uppery)

sleep



[Richard]

@ anonymous1337. How to split triangles resulting in 90 degree angles.
If the vertex angles at both ends of a side are less than 90 degrees then a normal from that edge to the opposite vertex will partition the triangle into two smaller triangles, both of which will have a 90 degree corner. On any triangle there will be either two or three sides that can generate this normal to an opposite vertex. For triangles that have an included vertex angle of 90 degrees or greater there will be only two solutions. All other triangles have three solutions. This all assumes that your triangles cannot have negative areas.

[Richard]

Albert's “Richard” topic became too difficult to clean up to a general family rating without loss of context, so once everyone had exchanged their views, and posts had stopped for three days, it was simply hidden. Here is a complete extract of bfullers post...

Time for my "2 cents worth" I think.

I think we need to give Albert a challenge----of the software kind. In the old Circles thread, he occassionaly came up with some good code, even if it did take a while for the maths behind it to sink in, and for him to accept the real limitations of the physical concepts he was trying to code.

We need to keep him occupied with coding challenges, he may even come up with solutions to some vexing problems you guys have. He obviously has plenty of time on his hands, and seems to churn out code endlessly when in the mood.

When he makes inappropriate remarks, the best is just to ignore them. We need to lead by example and also keep all responses to Albert's posts strictly to coding matters only. I think Counting_Pine should keep a watchful eye on his posts (or respond to our "nudges"), and delete those considered inappropriate. Albert has never actually complained about his posts being deleted, he just refuses to do it himself......

@Albert, it seems there are a number of people on this forum that think you have something to contribute. Our suggestion is to think a little bit more carefully about posting non-coding remarks, in fact just don't do it. Your Freebasic coding skills need to be focussed, they will continue to improve as time goes by.

Please write some code that will turn a number into a word as requested on a separate thread. Then a long number into a string of words, eventually convert any number to text. I'm sure you can do it. Do it over on the "Squares" topic--thats the best place for your contribution. In fact, my first challenge is to convert the algorithm b=a^2 into the text "a squared equals b" for any a. Ask the user to input a number. The user inputs 8, your program outputs "Eight squared equals Sixty Four". If the user inputs 2, then your program outputs "Two squared equals Four", for 100, the output is "One Hundred squared equals Ten Thousand" and so on, do this for any number input.

[rolliebollocks]

@Partitioning Triangles

You can partitionn a triangle into infinitely many triangles using Serpinski's fractal

http://en.wikipedia.org/wiki/Sierpinski_triangle

@anonymous1337

Are you doing what I think you're doing? Are you trying to crack a triangle? This would be a great way to go, in fact... I started writing a pixel editor, like a sprite editor type of thing, and I don't really know why.

I'm going to go break a triangle with serpinski's fractal:

#Theory

The mid point of each side can be used to create an upside down (180 rotation), but similar triangle inside of the original which will create 4 pieces...

This should work on any triangle.

Time to break a triangle.