| |
|
|
p.specht
| Weil physisches sortieren chez Datenbanken heutzutage mega-out ist, ici mon Version eines Quicksort-basierten sur- bzw. absteigenden INDEXERS comme Proc. (chez Datenbanken dauert physisches Sortieren simple viel trop longtemps. Neue Einträge volonté daher am Ende angefügt et lediglich qui index angepasst. Ähnlich simple ist ensuite logisches Effacer: on überspringt den entsprechenden index simple dans qui Verlinkungsliste)
Anmerkung: qui einleitende Hauptteil dient lediglich qui Zeitnehmung. Binnen 3 Sekunden laisser sich sur Float-Arrays compilé rund 9600 Indexe aufsteigend bzw. 9100 Indexierungen absteigend erzeugen. qui Algorithmus sollte relativ léger sur Stringarrays trop modifizieren son, wobei qui Leistung naturellement quelque chose sinken wird.
Titre de la fenêtre " Quickdex, qui QuickSort-Up/Down Indexer"
'(CL) CopyLeft 2014-10 by P.Specht, Wien; sans chacun Gewähr!
'{Quickdex, un QuickSort-Up/Down Indexer pour kleine Datenbestände
'----------------------------------------------------------------------------------------
' cette Hauptteil soll qui Zeit pour linear ansteigende Element-Anzahl montrer...
Fenêtre Style 24:Fenêtre 0,0-%maxx,%maxy-40
declare n&,x![],y![],k![],v&[],xm!,ym!,tm&:Set("decimals",17):randomize
Test:
n&=n& + 100'<< Inkrement qui Elemente-Anzahl (zum Testen des Zeitverhaltens)
':::imprimer "\n Setup de ";n&,"zu sortierenden Random-Floatwerten fonctionne..."
clear x![],y![],k![],v&[],xm!,ym!:setSize x![],n&:setsize y![],n&
x![]=rnd(height(%hwnd)):y![]=rnd(height(%hwnd))
':::Imprimer " Indexier-Kriterium wird erzeugt ..."
setsize k![],n&'Sortierkriteriums
setsize v&[],n&'Ergebnis: index pour chaque einzelne Sortierkriteriums-Element
' Schwerpunkt
whileloop 0,n&-1:xm!=xm!+x![&Boucle]:ym!=ym!+y![&Boucle]:endwhile :xm!=xm!/n&:ym!=ym!/n&
' Kriterium sei qui Punkt-Distanz zum Schwerpunkt
whileLoop 0,n&-1:k![&Boucle]=sqr(x![&Boucle]-xm!)+sqr(y![&Boucle]-ym!):endwhile'Kriterium k![]
'----------------------------------------------------------------------------------------
':::imprimer " Indexiervorgang gestartet... "
'tm&=&gettickcount:v&[]=QuickIndexUp9600(k![])
tm&=&gettickcount:v&[]=QuickIndexDwn9100(k![])
'----------------------------------------------------------------------------------------
tm&=&gettickcount-tm&:set("decimals",3)':Titre de la fenêtre str$(tm&/1000)+" sec":sound 2000,200
:::imprimer " Indexieren von",n&,"Elementen finissez dans "+str$(tm&/1000)+" sec":set("decimals",17)
':waitinput 10000
whileloop 0,n&-1
'::: imprimer tab(3);right$(" "+str$(& Loop),6);tab(17);format$("%g",k![v&[& Loop]]);
'::: imprimer tab(40);format$("%g",x![v&[& Loop]]);tab(70);format$("%g",y![v&[& Loop]])
'----------------------------------------------------------------------------------------
'2 PRÜFZEILEN GEBEN ALARM WENN SORTIERUNG NICHT ...<..aufsteigend ...>..absteigend:
si &loop>1:si k![v&[&Boucle]] > k![v&[&Boucle-1]]:Imprimer "\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
tandis que s&>0:l&=sl&[s&]:r&=sr&[s&]:s&=s&-1:tandis que l&<r&:i&=l&:j&=r&:p&=(l&+r&)\2
si a![v&[l&]]>a![v&[p&]] :t&=v&[l&]:v&[l&]=v&[p&]:v&[p&]=t&:endif
si a![v&[l&]]>a![v&[r&]] :t&=v&[l&]:v&[l&]=v&[r&]:v&[r&]=t&:endif
si a![v&[p&]]>a![v&[r&]] :t&=v&[p&]:v&[p&]=v&[r&]:v&[r&]=t&:endif :x!=a![v&[p&]]
tandis que i&<=j&:tandis que a![v&[i&]]<x!:inc i&:endwhile :tandis que x!<a![v&[j&]]:dec j&:endwhile
si i&<=j&:t&=v&[i&]:v&[i&]=v&[j&]:v&[j&]=t&: inc i&:dec j&:endif :endwhile
si (j&-l&)<(r&-i&):si i&<r&:s&=s&+1:sl&[s&]=i&:sr&[s&]=r&:endif :r&=j&:d'autre
si 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
tandis que s&>0:l&=sl&[s&]:r&=sr&[s&]:s&=s&-1:tandis que l&<r&:i&=l&:j&=r&:p&=(l&+r&)\2
si a![v&[l&]]>a![v&[p&]]:t&=v&[l&]:v&[l&]=v&[p&]:v&[p&]=t&:endif
si a![v&[l&]]>a![v&[r&]]:t&=v&[l&]:v&[l&]=v&[r&]:v&[r&]=t&:endif
si a![v&[p&]]>a![v&[r&]]:t&=v&[p&]:v&[p&]=v&[r&]:v&[r&]=t&:endif :x!=a![v&[p&]]
tandis que i&<=j&:tandis que a![v&[i&]]>x!:inc i&:endwhile :tandis que x!>a![v&[j&]]:dec j&:endwhile
si i&<=j&:t&=v&[i&]:v&[i&]=v&[j&]:v&[j&]=t&:inc i&:dec j&:endif :endwhile
si (j&-l&)<(r&-i&):si i&<r&:inc s&:sl&[s&]=i&:sr&[s&]=r&:endif :r&=j&:d'autre
si l&<j&:inc s&:sl&[s&]=l&:sr&[s&]=j&:endif :l&=i&:endif :endwhile :endwhile :return v&[]
endproc
|
|
|
| Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'... | 30.04.2021 ▲ |
|
|
|