## Squares

General FreeBASIC programming questions.
dodicat
Posts: 6720
Joined: Jan 10, 2006 20:30
Location: Scotland
rolliebollocks wrote:
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
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA
@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 routinedeclare Function minus(NUM1 As String,NUM2 As String) As String 'Dodicats integer subtraction routinedim as string n1,n2dim as string add_answer1,add_answer2dim as string sub_answer1,sub_answer2dim as double ts1,te1,tt1dim as double ts2,te2,tt2do    '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 endloopsleepEND'================================================='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 answerend 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 answerend 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 UbyteFor 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=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=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 UbyteFor 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,NUM1Swap lens,lenfswapflag=1Endif        '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+threeEnd Function`
dodicat
Posts: 6720
Joined: Jan 10, 2006 20:30
Location: Scotland
albert wrote:@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 answerEnd Function    '***dim as string s1,s2,s3s1="123456"s2="1"s3=subtract(s1,s2)print s1;"  -  ";s2print s3sleep`

I've got my add to float now, it slows it a bit of course, maybe have to do it better.
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 variablesdim shared As Long num1_length,num2_length,diffdim 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 Ubytedim shared sub_bool(0 To 19) As UbyteFor 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 #endmacrodim shared As Long n,pstdim 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=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=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:#endmacrocompare(numbers)If bigger Then sign="-"Swap NUM2,NUM1Swap num2_length,num1_lengthswap_flag=1Endif                 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 ADDfunction _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 ADDFunction 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 answerEnd 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 answerEnd Function    '***************************************************Dim As String n1,n2,answer1,answer2Dim As Double ts1,te1,tt1Dim As Double ts2,te2,tt2Print "Press space to start, then no other key"SleepPrint "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 EndPrint "continuing, press spacebar now if you want to quit next time round"LoopSleepEnd `
dodicat
Posts: 6720
Joined: Jan 10, 2006 20:30
Location: Scotland
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 UbyteFor 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)scopeif 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+part2end ifend 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=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=addcarry+fortyeight    finish(three)End Function'dodicat integer subtractFunction 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:#endmacrocompare(numbers)If bigger Then sign="-"Swap NUM2,NUM1Swap lens,lenfswapflag=1Endif                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+threeEnd Function'dodicat positive float addfunction _add(number1 as string,number2 as string) as string       'dim  as string part1,part2dim  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=answerend function'dodicat positive float subtractfunction _subtract(number1 as string,number2 as string) as string       'dim  as string part1,part2dim  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 ifif 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+"."+answerend if     decpos=len(answer)-decpos     insertpoint(answer,".",decpos+1)     return sign+answerend function'ALBERT'S ADDFunction 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 answerEnd Function 'ALBERT SUBTRACTFunction 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 answerEnd Function   Dim As String n1,n2,answer1,answer2Dim As Double ts1,te1,tt1Dim As Double ts2,te2,tt2Print "Press space to start, then no other key"SleepPrint "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 doPrint "continuing, press spacebar now if you want to quit next time round"Loopprint "Press a key"sleeprandomizeFunction r(first As Double, last As Double) As Double    Function = Rnd * (last - first) + firstEnd Function'Testing dodicat's subtractprint "Test dodicat 500 subtractions"for z as integer=1 to 500n1=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,n2next zprint "DODICAT done"'Testing ALBERT'S subtractprint "Test Albert 500 subtractions"for z as integer=1 to 500n1=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 ifnext zprint "ALBERT done"print _subtract("468.8721769042313","5.807500198949128")print subtract("468.8721769042313","5.807500198949128")SleepEnd `
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA
@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
Posts: 5494
Joined: Sep 12, 2005 20:06
Location: California
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 = 0dim as double beginprint "Hit any key to begin."sleepbegin = 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    nextprint "Total solutions found: " & solutionsprint "Total time taken: " & timer() - beginsolutions = 0sleepbegin = 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    nextprint "Total solutions found: " & solutionsprint "Total time taken: " & timer() - beginsolutions = 0sleep`
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA
@Dodicat

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

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 answerEnd Function    '***Dim As String s1,s2,s3s1="123456"s2="1"s3=subtract(s1,s2)Print s1;"  -  ";s2Print s3Sleep`
dodicat
Posts: 6720
Joined: Jan 10, 2006 20:30
Location: Scotland
anonymous1337 wrote: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
Posts: 6720
Joined: Jan 10, 2006 20:30
Location: Scotland
albert wrote:@Dodicat

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

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 UbyteFor 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)scopeif 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+part2end ifend 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=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=addcarry+fortyeight    finish(three)End Function'dodicat integer subtractFunction 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:#endmacrocompare(numbers)If bigger Then sign="-"Swap NUM2,NUM1Swap lens,lenfswapflag=1Endif                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+threeEnd Function'dodicat positive float addfunction _add(number1 as string,number2 as string) as string       'dim  as string part1,part2dim  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=answerend function'dodicat positive float subtractfunction _subtract(number1 as string,number2 as string) as string       'dim  as string part1,part2dim  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 ifif 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+"."+answerend if     decpos=len(answer)-decpos     insertpoint(answer,".",decpos+1)     return sign+answerend function'ALBERT'S ADDFunction 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 answerEnd Function 'ALBERT SUBTRACTFunction 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 answerEnd Function   Dim As String n1,n2,answer1,answer2Dim As Double ts1,te1,tt1Dim As Double ts2,te2,tt2Print "Press space to start, then no other key"SleepPrint "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 doPrint "continuing, press spacebar now if you want to quit next time round"Loopprint "Press a key"sleeprandomizeFunction r(first As Double, last As Double) As Double    Function = Rnd * (last - first) + firstEnd Function'Testing dodicat's subtractprint "Test dodicat 50 subtractions"ts1=timerfor z as integer=1 to 50n1=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,n2next zts2=timerprint "DODICAT done time = ";ts2-ts1print'Testing ALBERT'S subtractprint "Test Albert 50 subtractions"ts1=timerfor z as integer=1 to 50n1=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 ifnext zts2=timerprint "ALBERT done time = ";ts2-ts1print _subtract("468.8721769042313","468.8721769042319")print  subtract("468.8721769042313","468.8721769042319")SleepEnd `
anonymous1337
Posts: 5494
Joined: Sep 12, 2005 20:06
Location: California
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
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA
@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
Posts: 6720
Joined: Jan 10, 2006 20:30
Location: Scotland
albert wrote:@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,yresscreeninfo xres,yresscreenres xres,yres,32#macro drawline(x1,y1,x2,y2,minx,maxx,miny,maxy)'axisscopeif 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    'axisif 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=-100upperx=100lowery=-100uppery=100dim as double x1,y1,x2,y2,x3,y3,centroidx,centroidy'The three vertices of a triangle in the cartesian graphx1=-20:y1=-20x2=80:y2=20x3=20:y3=-90'The centroidcentroidx=(x1+x2+x3)/3centroidy=(y1+y2+y3)/3'DRAW THE TRIANGLE AND IT'S CENTROIDdrawline(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
Posts: 3036
Joined: Jan 15, 2007 20:44
Location: Australia
@ 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
Posts: 3036
Joined: Jan 15, 2007 20:44
Location: Australia
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...
bfuller wrote: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
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york
@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.