XProfan

Italia

p.specht

Weil physisches sortieren bei Datenbanken heutzutage mega-out ist, hier meine Version eines Quicksort-basierten auf- bzw. absteigenden INDEXERS als Proc.
(Bei Datenbanken dauert physisches Sortieren einfach viel zu lange. Neue Einträge werden daher am Ende angefügt und lediglich der Index angepasst. Ähnlich einfach ist dann logisches Löschen: Man überspringt den entsprechenden Index einfach in der Verlinkungsliste)

Anmerkung: Der einleitende Hauptteil dient lediglich der Zeitnehmung. Binnen 3 Sekunden lassen sich auf Float-Arrays compiliert rund 9600 Indexe aufsteigend bzw. 9100 Indexierungen absteigend erzeugen. Der Algorithmus sollte relativ leicht auf Stringarrays zu modifizieren sein, wobei die Leistung naturalmente etwas sinken wird.

Kompilieren Markieren Separieren

WindowTitle " Quickdex, der QuickSort-Up/Down Indexer"
'(CL) CopyLeft 2014-10 by P.Specht, Wien; ohne jede Gewähr!
'{Quickdex, ein QuickSort-Up/Down Indexer per kleine Datenbestände
'----------------------------------------------------------------------------------------
' Dieser Hauptteil soll die Zeit per linear ansteigende Element-Anzahl zeigen...
WindowStyle 24:Window 0,0-%maxx,%maxy-40
declare n&,x![],y![],k![],v&[],xm!,ym!,tm&:Set("decimals",17):randomize
Test:
n&=n& + 100'<< Inkrement der Elemente-Anzahl (zum Testen des Zeitverhaltens)
':::print "\n Setup von ";n&,"zu sortierenden Random-Floatwerten corre..."
clear x![],y![],k![],v&[],xm!,ym!:setSize x![],n&:setsize y![],n&
x![]=rnd(height(%hwnd)):y![]=rnd(height(%hwnd))
':::Print " Indexier-Kriterium wird erzeugt ..."
setsize k![],n&'Sortierkriteriums
setsize v&[],n&'Ergebnis: Index per jedes einzelne Sortierkriteriums-Element
' Schwerpunkt

whileloop 0,n&-1:xm!=xm!+x![&Loop]:ym!=ym!+y![&Loop]:endwhile :xm!=xm!/n&:ym!=ym!/n&

    ' Kriterium sei die Punkt-Distanz zum Schwerpunkt

    whileLoop 0,n&-1:k![&Loop]=sqr(x![&Loop]-xm!)+sqr(y![&Loop]-ym!):endwhile'Kriterium k![]

        '----------------------------------------------------------------------------------------
        ':::print " Indexiervorgang gestartet... "
        'tm&=&gettickcount:v&[]=QuickIndexUp9600(k![])
        tm&=&gettickcount:v&[]=QuickIndexDwn9100(k![])
        '----------------------------------------------------------------------------------------
        tm&=&gettickcount-tm&:set("decimals",3)':WindowTitle str$(tm&/1000)+" sec":sound 2000,200
        :::print " Indexieren von",n&,"Elementen beendet in "+str$(tm&/1000)+" sec":set("decimals",17)
        ':waitinput 10000

        whileloop 0,n&-1

            '::: print tab(3);right$("     "+str$(&Loop),6);tab(17);format$("%g",k![v&[&Loop]]);
            '::: print tab(40);format$("%g",x![v&[&Loop]]);tab(70);format$("%g",y![v&[&Loop]])
            '----------------------------------------------------------------------------------------
            '2 PRÜFZEILEN GEBEN ALARM WENN SORTIERUNG NICHT ...<..aufsteigend ...>..absteigend:

            if &loop>1:if k![v&[&Loop]]  >  k![v&[&Loop-1]]:Print "\n *** PRÜFREIHENFOLGE FALSCH! *** "

                sound 2000,500:waitinput :endif :endif
                '----------------------------------------------------------------------------------------

            endwhile'::: waitinput 60000

            GOTO "Test"
            '}

            proc QuickIndexUp9600 :parameters a![]:declare n&,p&,l&,r&,s&,sl&[],sr&[],w!,t&,x!,i&,j&,v&[]

                n&=sizeof(a![]):setsize v&[],n&:v&[]=&Index:s&=1:sl&[1]=0:sr&[1]=n&-1

                while s&>0:l&=sl&[s&]:r&=sr&[s&]:s&=s&-1:while l&<r&:i&=l&:j&=r&:p&=(l&+r&)\2

                    if a![v&[l&]]>a![v&[p&]] :t&=v&[l&]:v&[l&]=v&[p&]:v&[p&]=t&:endif

                        if a![v&[l&]]>a![v&[r&]] :t&=v&[l&]:v&[l&]=v&[r&]:v&[r&]=t&:endif

                            if a![v&[p&]]>a![v&[r&]] :t&=v&[p&]:v&[p&]=v&[r&]:v&[r&]=t&:endif :x!=a![v&[p&]]

                                while i&<=j&:while a![v&[i&]]<x!:inc i&:endwhile :while x!<a![v&[j&]]:dec j&:endwhile

                                    if i&<=j&:t&=v&[i&]:v&[i&]=v&[j&]:v&[j&]=t&: inc i&:dec j&:endif :endwhile

                                        if (j&-l&)<(r&-i&):if i&<r&:s&=s&+1:sl&[s&]=i&:sr&[s&]=r&:endif :r&=j&:else

                                            if l&<j&:s&=s&+1:sl&[s&]=l&:sr&[s&]=j&:endif :l&=i&:endif :endwhile :endwhile :return v&[]

                                            endproc

                                            proc QuickIndexDwn9100 :parameters a![]:declare n&,p&,l&,r&,s&,sl&[],sr&[],w!,t&,x!,i&,j&,v&[]

                                                n&=sizeof(a![]):s&=1:setsize v&[],n&:v&[]=&index:s&=1:sl&[1]=0:sr&[1]=n&-1

                                                while s&>0:l&=sl&[s&]:r&=sr&[s&]:s&=s&-1:while l&<r&:i&=l&:j&=r&:p&=(l&+r&)\2

                                                    if a![v&[l&]]>a![v&[p&]]:t&=v&[l&]:v&[l&]=v&[p&]:v&[p&]=t&:endif

                                                        if a![v&[l&]]>a![v&[r&]]:t&=v&[l&]:v&[l&]=v&[r&]:v&[r&]=t&:endif

                                                            if a![v&[p&]]>a![v&[r&]]:t&=v&[p&]:v&[p&]=v&[r&]:v&[r&]=t&:endif :x!=a![v&[p&]]

                                                                while i&<=j&:while a![v&[i&]]>x!:inc i&:endwhile :while x!>a![v&[j&]]:dec j&:endwhile

                                                                    if i&<=j&:t&=v&[i&]:v&[i&]=v&[j&]:v&[j&]=t&:inc i&:dec j&:endif :endwhile

                                                                        if (j&-l&)<(r&-i&):if i&<r&:inc s&:sl&[s&]=i&:sr&[s&]=r&:endif :r&=j&:else

                                                                            if l&<j&:inc s&:sl&[s&]=l&:sr&[s&]=j&:endif :l&=i&:endif :endwhile :endwhile :return v&[]

                                                                            endproc