XProfan

English

p.specht

because physisches sort with Databases nowadys mega-out is, here my Version one Quicksort-based on- or. absteigenden INDEXERS as Proc.
(with Databases lasts physisches sort simply plenty too long. new Entries go therefore end angefügt and solely the index adjusted. Similar simply is then logisches Delete: one skipping whom suitable index simply in the Verlinkungsliste)

Note: The einleitende Hauptteil serves solely the Zeitnehmung. Binnen 3 sec can on Float-Arrays compiliert round 9600 Indexe ascending or. 9100 Indexierungen absteigend produce. The Algorithmus ought to relatively slight on Stringarrays To modify his, where The performance naturally something sink becomes.

Compile Mark Separation

Window Title " Quickdex, the QuickSort-Up/Down Indexer"
'(CL) CopyLeft 2014-10 by P.woodpecker, Wien; without each Gewähr!
'{Quickdex, one QuickSort-Up/Down Indexer for small Datenbestände
'----------------------------------------------------------------------------------------
' this Hauptteil should The Time for linear ansteigende element-amount show...
Window Style 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 the items-amount (to that testing the Zeitverhaltens)
':::print "\n Setup of ";n&,"zu sortierenden Random-Floatwerten runs..."
clear x![],y![],k![],v&[],xm!,ym!:setSize x![],n&:setsize y![],n&
x![]=rnd(height(%hwnd)):y![]=rnd(height(%hwnd))
':::Print " Indexier-Kriterium becomes created ..."
setsize k![],n&'Sortierkriteriums
setsize v&[],n&'Result: index for each single Sortierkriteriums-element
' Schwerpunkt

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

    ' Kriterium be The point-distance to that Schwerpunkt

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

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

        whileloop 0,n&-1

            '::: print tab(3);right$("     "+st$(& 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 IF SORTIERUNG NOT ...<..ascending ...>..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