|
Es gibt eine ganze Reihe verschiedener Algorithmen zum Sortieren eines Datenfeldes (Arrays), vom Bubblesort- bis zum Quicksort-Algorithmus, oder wie sie alle heißen mögen. Sie werden sicher schnell im Internet fündig, wenn Sie einmal nach einer entsprechenden Umsetzung in Visual Basic suchen. Gute Lösungen für den umgekehrten Weg, nämlich die Elemente eines wohlsortierten Arrays (wieder) in eine garantiert ungeordnete, zufällige Reihenfolge zu bringen, sind dagegen ziemlich selten anzutreffen. Wozu das gut sein soll, fragen Sie? Nun, es mag den einen oder anderen Grund geben - aber ich halte es einfach mal so: Hier finden Sie die Lösung, und die Suche nach dem passenden Problem ist Ihr Bier...
Das "Desortier"-Prinzip ist einfach. Wir können schließlich davon ausgehen, dass die Anzahl der Elemente des Ausgangs-Arrays und des Ziel-Arrays übereinstimmen. Wir nehmen uns also jedes Element des Ausgangs-Arrays vor und versuchen, es an eine andere Stelle im Ziel-Arrays, deren Index wir jeweils zufällig ermitteln (siehe  "Wie der Zufall es will"), zu stecken. Ist dort noch kein Element abgelegt, nehmen wie die Neuzuweisung vor, anderenfalls lassen wir den Zufallszahlengenerator so lange nach einem freien Index suchen, bis einer gefunden ist. Letzteres dauert natürlich um so länger, je mehr das Ziel-Array bereits gefüllt ist, weil damit ja zwangsläufig die Anzahl der Fehlversuche zunehmend steigt. Die letzten freien Stellen zu finden kann unter Umständen relativ lange dauern - kritisch wird es meinen Versuchen zufolge aber erst ab Array-Größen von mehreren hundertausend Elementen. Es gibt meines Wissens kein verkürzendes Verfahren, bei dem etwa der dem Zufall zur Verfügung stehende Suchraum kontinuierlich eingeschränkt würde, und das sich in Visual Basic tatsächlich Performance gewinnend implementieren ließe.
Ob eine Stelle im Ziel-Array belegt ist, lässt sich bei String-Arrays prüfen, indem mittels der (undokumentierten) VB-Funktion StrPtr der Initialisierungszustand des betreffenden Elements geprüft wird. Liefert StrPtr den Wert 0, ist dem Element noch kein String-Wert zugewiesen worden.
Public Function ArrayRandomizeStr(Arr() As String) As Variant
Dim nLBound As Long
Dim nUBound As Long
Dim nNewArr() As String
Dim l As Long
Dim nNewIndex As Long
Dim nRndArg As Long
nLBound = LBound(Arr)
nUBound = UBound(Arr)
ReDim nNewArr(nLBound To nUBound)
Randomize Timer
nRndArg = nUBound - nLBound + 1
For l = nLBound To nUBound
Do
nNewIndex = Int(nRndArg * Rnd + nLBound)
Loop While StrPtr(nNewArr(nNewIndex))
nNewArr(nNewIndex) = Arr(l)
Next 'l
ArrayRandomizeStr = nNewArr
End Function
Bei Arrays aller anderen Datentypen ist eine solche Prüfung des "jungfräulichen" Zustands eines Elements leider nicht möglich. Daher benötigen wir bei diesen ein zusätzliches Array des Typs Boolean in gleicher Größe, in dem die Belegung einer Stelle markiert wird. Hier sehen Sie nun (stellvertretend) die Funktion für Arrays des Datentyps Long:
Public Function ArrayRandomizeLong(Arr() As Long) As Variant
Dim nLBound As Long
Dim nUBound As Long
Dim nNewArr() As Long
Dim nNewArrFlags() As Boolean
Dim l As Long
Dim nNewIndex As Long
Dim nRndArg As Long
nLBound = LBound(Arr)
nUBound = UBound(Arr)
ReDim nNewArr(nLBound To nUBound)
ReDim nNewArrFlags(nLBound To nUBound)
Randomize Timer
nRndArg = nUBound - nLBound + 1
For l = nLBound To nUBound
Do
nNewIndex = Int(nRndArg * Rnd + nLBound)
Loop While nNewArrFlags(nNewIndex)
nNewArr(nNewIndex) = Arr(l)
nNewArrFlags(nNewIndex) = True
Next 'l
ArrayRandomizeLong = nNewArr
End Function
Falls Sie bei einem String-Array den kleinen Trick mit der StrPtr-Funktion nicht nutzen können, weil auch in dem Ausgangs-Array schon nicht initialisierte Elemente enthalten sein könnten, können Sie das allgemeinere Verfahren für die übrigen Datentypen mit der Markierung in einem Boolean-Array auch für Strings adaptieren:
Public Function ArrayRandomizeStr2(Arr() As String) As Variant
Dim nLBound As Long
Dim nUBound As Long
Dim nNewArr() As String
Dim nNewArrFlags() As Boolean
Dim l As Long
Dim nNewIndex As Long
Dim nRndArg As Long
nLBound = LBound(Arr)
nUBound = UBound(Arr)
ReDim nNewArr(nLBound To nUBound)
ReDim nNewArrFlags(nLBound To nUBound)
Randomize Timer
nRndArg = nUBound - nLBound + 1
For l = nLBound To nUBound
Do
nNewIndex = Int(nRndArg * Rnd + nLBound)
Loop While nNewArrFlags(nNewIndex)
nNewArr(nNewIndex) = Arr(l)
nNewArrFlags(nNewIndex) = True
Next 'l
ArrayRandomizeStr2 = nNewArr
End Function
Aber eigentlich ist das nicht notwendig. Denn am Ende bleiben auch im Ziel-Array genau so viele Elemente uninitialisiert, wie im Ausgangs-Array vorhanden waren.
|