[VB6] 2d array sorteren (met quicksort)

[sturkel]

Ik heb een array die ik wil sorteren aan de hand van het tweede veld.
voorbeeld:

code:

Array(0, 0) = "aaa"
Array(0, 1) = "3"
Array(0, 2) = "3.1"
Array(0, 3) = "aaa"

Array(1, 0) = "bbb"
Array(1, 1) = "1"
Array(1, 2) = "1.1"
Array(1, 3) = "bbb"

Array(2, 0) = "ccc"
Array(2, 1) = "2"
Array(2, 2) = "2.1"
Array(2, 3) = "ccc"

Nu wil ik dus da de array gesorteerd wordt aan de hand van Array(x, 1) welke een string is.
Ik heb al verschillende voorbeelden geprobeerd, maar krijg er geen van allen werkend.
Volgens mij is het quicksort algoritme hiervoor geschikt.
Wie kan me op weg helpen met een voorbeeld of tip?

[RobIII]

Laat eens zien wat je geprobeerd hebt? Dan kunnen we daar misschien zinnige input op geven, want meer dan "quicksort is prima geschikt voor dit soort doeleinden" kunnen we nu niet echt zeggen he?
(Zorg dan wel dat je enkel relevante code post).

En wat bedoel je met "Ik heb al verschillende voorbeelden geprobeerd, maar krijg er geen van allen werkend"? Bedoel je copy/paste van een website en bidden dat het werkt? Of...? Want op deze manier is het gewoon een (min of meer verkapt) scriptrequest

[ Voor 53% gewijzigd door RobIII op 23-07-2007 17:16 ]

[sturkel]

Als ik dit voorbeeld pak, kan ik geen veld opgeven waar op gesorteerd moet worden

code:

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef lpDest As Any, ByRef lpSource As Any, ByVal iLen As Long)


Public Sub sTriQuickSortString(ByRef sArray() As String)
   Dim iLBound As Long
   Dim iUBound As Long
   On Error GoTo sTriQuickSortString_ERROR
   
   iLBound = LBound(sArray, 2)
   iUBound = UBound(sArray, 2)
   
   sTriQuickSortString2 sArray, 4, iLBound, iUBound
   sInsertionSortString sArray, iLBound, iUBound
   Exit Sub
   
sTriQuickSortString_ERROR:
   Err.Raise Err.Number, Err.Source, Err.Description
End Sub

Private Sub sTriQuickSortString2(ByRef sArray() As String, ByVal iSplit As Long, ByVal iMin As Long, ByVal iMax As Long)
   Dim i      As Long
   Dim j      As Long
   Dim sTemp1 As String
   Dim sTemp2 As String
   
   If (iMax - iMin) > iSplit Then
      i = (iMax + iMin) / 2
      
      If sArray(1, iMin) > sArray(1, i) Then
         sSwapStrings sArray(1, iMin), sArray(1, i)
         sSwapStrings sArray(2, iMin), sArray(2, i)
      End If
      
      If sArray(1, iMin) > sArray(1, iMax) Then
         sSwapStrings sArray(1, iMin), sArray(1, iMax)
         sSwapStrings sArray(2, iMin), sArray(2, iMax)
      End If
      
      If sArray(1, i) > sArray(1, iMax) Then
         sSwapStrings sArray(1, i), sArray(1, iMax)
         sSwapStrings sArray(2, i), sArray(2, iMax)
      End If
      
      j = iMax - 1
      sSwapStrings sArray(1, i), sArray(1, j)
      sSwapStrings sArray(2, i), sArray(2, j)
      i = iMin
      CopyMemory ByVal VarPtr(sTemp1), ByVal VarPtr(sArray(1, j)), 4
      CopyMemory ByVal VarPtr(sTemp2), ByVal VarPtr(sArray(2, j)), 4
      
      Do
         Do
            i = i + 1
         Loop While sArray(1, i) < sTemp1
         
         Do
            j = j - 1
         Loop While sArray(1, j) > sTemp1
         
         If j < i Then Exit Do
         sSwapStrings sArray(1, i), sArray(1, j)
         sSwapStrings sArray(2, i), sArray(2, j)
      Loop
      
      sSwapStrings sArray(1, i), sArray(1, iMax - 1)
      sSwapStrings sArray(2, i), sArray(2, iMax - 1)
      
      sTriQuickSortString2 sArray, iSplit, iMin, j
      sTriQuickSortString2 sArray, iSplit, i + 1, iMax
   End If
   
   i = 0
   CopyMemory ByVal VarPtr(sTemp1), ByVal VarPtr(i), 4
   CopyMemory ByVal VarPtr(sTemp2), ByVal VarPtr(i), 4
End Sub

Private Sub sInsertionSortString(ByRef sArray() As String, ByVal iMin As Long, ByVal iMax As Long)
   Dim i      As Long
   Dim j      As Long
   Dim sTemp1 As String
   Dim sTemp2 As String
   
   For i = iMin + 1 To iMax
      CopyMemory ByVal VarPtr(sTemp1), ByVal VarPtr(sArray(1, i)), 4
      CopyMemory ByVal VarPtr(sTemp2), ByVal VarPtr(sArray(2, i)), 4
      j = i
      
      Do While j > iMin
         If sArray(1, j - 1) <= sTemp1 Then Exit Do

         CopyMemory ByVal VarPtr(sArray(1, j)), ByVal VarPtr(sArray(1, j - 1)), 4
         CopyMemory ByVal VarPtr(sArray(2, j)), ByVal VarPtr(sArray(2, j - 1)), 4
         j = j - 1
      Loop
      
      CopyMemory ByVal VarPtr(sArray(1, j)), ByVal VarPtr(sTemp1), 4
      CopyMemory ByVal VarPtr(sArray(2, j)), ByVal VarPtr(sTemp2), 4
   Next i
   
   i = 0
   CopyMemory ByVal VarPtr(sTemp1), ByVal VarPtr(i), 4
   CopyMemory ByVal VarPtr(sTemp2), ByVal VarPtr(i), 4
End Sub

Private Sub sSwapStrings(ByRef s1 As String, ByRef s2 As String)
   Dim i As Long

   i = StrPtr(s1)
   If i = 0 Then CopyMemory ByVal VarPtr(i), ByVal VarPtr(s1), 4

   CopyMemory ByVal VarPtr(s1), ByVal VarPtr(s2), 4
   CopyMemory ByVal VarPtr(s2), i, 4
End Sub

dit zou een goed voorbeeld zijn, maar dit geld alleen voor numerieke sortering (long):

code:

Private testArray() As Long
Private bRedimArray As Boolean
Const LowboundOfArray As Byte = 0

Private Sub TriQuickSortLong(ByRef iArray() As Long, ByVal iMemberID As Byte, Optional ByVal bSortDesc As Boolean)
   Dim iLBound As Long
   Dim iUBound As Long
   Dim I       As Long
   Dim J       As Long
   Dim iTemp   As Long
   
   iLBound = LBound(iArray, 2)
   iUBound = UBound(iArray, 2)
   
   ' *NOTE*  the value 4 is VERY important here !!!
   ' DO NOT CHANGE 4 FOR A LOWER VALUE !!!
   TriQuickSortLong2 iArray, 4, iLBound, iUBound, iMemberID
   InsertionSortLong iArray, iLBound, iUBound, iMemberID
   
    If bSortDesc Then ReverseLongArray iArray()

End Sub

Private Sub TriQuickSortLong2(ByRef iArray() As Long, ByVal iSplit As Long, ByVal iMin As Long, ByVal iMax As Long, ByVal iMemberID As Byte)
   Dim I     As Long
   Dim J     As Long
   Dim iTemp() As Long
   Dim k As Long

   ReDim iTemp(LBound(iArray, 1) To UBound(iArray, 1))

   If (iMax - iMin) > iSplit Then
      I = (iMax + iMin) / 2
      
      If iArray(1, iMin) > iArray(1, I) Then SwapLongs iArray(), iMin, I
      If iArray(1, iMin) > iArray(1, iMax) Then SwapLongs iArray(), iMin, iMax
      If iArray(1, I) > iArray(1, iMax) Then SwapLongs iArray(), I, iMax
      
      J = iMax - 1
      SwapLongs iArray(), I, J
      
      I = iMin
      For k = LBound(iTemp) To UBound(iTemp)
        iTemp(k) = iArray(k, J)
      Next
        
      
      Do
         Do
            I = I + 1
         Loop While iArray(iMemberID, I) < iTemp(iMemberID)
         
         Do
            J = J - 1
         Loop While iArray(iMemberID, J) > iTemp(iMemberID) And J > iMin
' Note: Only logic modification I made was to add the "J > iMin" above
' In certain cases, J would fall below iMin & routine would crash
'//LaVolpe
         If J < I Then Exit Do
         
         SwapLongs iArray(), I, J
      Loop
      
      SwapLongs iArray(), I, iMax - 1
      
      TriQuickSortLong2 iArray, iSplit, iMin, J, iMemberID
      TriQuickSortLong2 iArray, iSplit, I + 1, iMax, iMemberID
   End If
End Sub

   Private Sub SwapLongs(ByRef iArray, Index1 As Long, Index2 As Long)
   Dim I As Long, J As Long
   For J = LBound(iArray, 1) To UBound(iArray, 1)
    I = iArray(J, Index1)
    iArray(J, Index1) = iArray(J, Index2)
    iArray(J, Index2) = I
   Next
   End Sub

Private Sub InsertionSortLong(ByRef iArray() As Long, ByVal iMin As Long, ByVal iMax As Long, iMemberID As Byte)
   Dim I     As Long
   Dim J     As Long
   Dim iTemp() As Long
   Dim k As Long
   ReDim iTemp(LBound(iArray, 1) To UBound(iArray, 1))
   
   For I = iMin + 1 To iMax
      For k = LBound(iTemp) To UBound(iTemp)
        iTemp(k) = iArray(k, I)
      Next
      J = I
      
      Do While J > iMin
         If iArray(iMemberID, J - 1) <= iTemp(iMemberID) Then Exit Do

         For k = LBound(iTemp) To UBound(iTemp)
            iArray(k, J) = iArray(k, J - 1)
         Next
         
         J = J - 1
      Loop
      
        For k = LBound(iTemp) To UBound(iTemp)
            iArray(k, J) = iTemp(k)
        Next
   Next I
End Sub

Private Sub ReverseLongArray(ByRef iArray() As Long)
   Dim iLBound As Long
   Dim iUBound As Long

   iLBound = LBound(iArray, 2)
   iUBound = UBound(iArray, 2)
   
   While iLBound < iUBound
      SwapLongs iArray(), iLBound, iUBound
   
      iLBound = iLBound + 1
      iUBound = iUBound - 1
   Wend
End Sub

Dus wat ik zoek is eigenlijk een combinatie van beide, waarbij de array een string() is en ik een veld kan opgeven array(x,veld) waarop gesorteerd moet worden.
Er zijn naar mijn mening genoeg voorbeelden, maar de meeste zijn of 1-dimensional of alleen voor integers/longs

[RobIII]

Dus je zoekt een kant-en-klare oplossing? Dan ben je hier in PRG aan het verkeerde adres Zo'n beetje elke quicksort is prima aan te passen aan hetgeen jij wilt. Wat heb je in bovenstaande 'geleende' code aangepast? Wat heb je geprobeerd? Wat werkt(e) er niet?

[ Voor 31% gewijzigd door RobIII op 23-07-2007 17:30 ]

[sturkel]

RobIII schreef op maandag 23 juli 2007 @ 17:29:
Dus je zoekt een kant-en-klare oplossing? Dan ben je hier in PRG aan het verkeerde adres Zo'n beetje elke quicksort is prima aan te passen aan hetgeen jij wilt. Wat heb je in bovenstaande 'geleende' code aangepast? Wat heb je geprobeerd? Wat werkt(e) er niet?

Ik vraag niet om een kant en klaar voorbeeld, maar om een voorbeeld of tip in de juiste richting, wat toch mag volgens de policy.
Met jou hulp schiet toch ook niemand op, of zie ik dat nu verkeerd?

[RobIII]

Ik zou niet weten hoe ik je moest helpen als je geen concrete vraag stelt.
Ik kan je wel vertellen dat het geen fluit uit maakt of je nu strings, integers, floats, (één- of meerdimensionale) arrays of objecten sorteert en dat het principe hetzelfde blijft. Ik kan je ook vertellen dat je met een extra parameter bij je quicksort zou kunnen 'meegeven' op wélk element/dimensie je wil sorteren, of dat je die parameter ook achterwege kunt laten en het gewoon lekker hardcoden in je quicksort algo. Maar met die 'tips' dan ben je nog niet geholpen.

En ik kan je niet vertellen wat je dan precies moet zolang je geen concrete vraag stelt (je vraagt nu: hoe sorteer ik een tweedimensionale array? Mijn antwoord: Hetzelfde als een enkele dimensie array, of een 3 dimensionale array, mits je je algoritme aanpast de juiste elementen te vergelijken en swappen).

Of je nou appels of peren (quick)sort(eert), dat boeit toch niet? Het idee blijft toch hetzelfde? Alleen, als je appels sorteert dan doe je dat op prijs en bij peren op gewicht (bijvoorbeeld). En als je appels 'swapt' doe je dat gewoon door enkel de appels te wisselen, en als je peren 'swapt' moet je de gekoppelde meloen ook meeswappen. Maakt dat het duidelijker?

Ik kan je wel nog zo vertellen dat ik, op het oog, schat dat je geen tweedimensionale array nodig hebt en dat je beter een UDT of een Class zou kunnen gebruiken om je waardes in te stoppen en die te sorteren. Daar is je tip

[ Voor 36% gewijzigd door RobIII op 23-07-2007 17:51 ]

[sturkel]

RobIII schreef op maandag 23 juli 2007 @ 17:44:
Ik zou niet weten hoe ik je moest helpen als je geen concrete vraag stelt.

Hoe pas ik het onderste script aan (parameters, vergelijking) zodat ik een kolom kan opgeven

RobIII schreef op maandag 23 juli 2007 @ 17:44:
Ik kan je wel nog zo vertellen dat ik, op het oog, schat dat je geen tweedimensionale array nodig hebt en dat je beter een UDT of een Class zou kunnen gebruiken om je waardes in te stoppen en die te sorteren. Daar is je tip

Wat biedt volgens jou dan voordelen, als je al een array hebt (die via een generieke functie wordt gevuld), tegenover een class of een eigen brouwsel?
Snap wel dat een scriptrequest niet de bedoeling is, maar zie niet hoe ik de (tri)quicksort aan moet passen om het gewenste resultaat te krijgen, daarvan mijn vraag.

[RobIII]

sturkel schreef op maandag 23 juli 2007 @ 17:52:
Wat biedt volgens jou dan voordelen, als je al een array hebt (die via een generieke functie wordt gevuld), tegenover een class of een eigen brouwsel?

Dat je code een stuk leesbaarder wordt dan SomeArray(5,9). Dan kun je toch veel beter MyProduct.Price schrijven ofzo? En wat versta je onder 'eigen brouwsel'? In essentie gebruik je de Class ook als een UDT op het moment dat de class verder geen toegevoegde functionaliteit heeft.

sturkel schreef op maandag 23 juli 2007 @ 17:52:
Snap wel dat een scriptrequest niet de bedoeling is, maar zie niet hoe ik de (tri)quicksort aan moet passen om het gewenste resultaat te krijgen, daarvan mijn vraag.

Dat heb ik je dus zojuist uitgelegd: je zult de vergelijking ('moet ik swappen of niet') moeten aanpassen zodat deze naar het juiste element kijkt én je zult bij de swap alle 'bijbehorende elementen' moeten swappen. Maar dat 2e punt bespaar je jezelf al als je er een UDT of Object van maakt want die swap je net zo makkelijk als een integer of string. (En granted; in een meerdimensionale array kun je elementen ook 'makkelijk' swappen, het is alleen meer werk).

Ik doe dit niet om je te pesten; ik kan er helaas gewoon niet meer zinnigs op zeggen behalve je (helaas ook nog 'geleende') code te pakken, die te gaan zitten analyseren en dan de wijzigingen voor te stellen (of zelfs voor je uitwerken); en dat is dus iets waar ik geen zin in heb en wat hier ook niet gewenst is ('voorkauwen').

Give a man a fish and you feed him for a day. Teach a man to fish and you feed him for a lifetime.

Mijn beste tip tot nu toe is dan ook: verdiep je eens in het (of een) quicksort algoritme, bekijk en bestudeer het principe en schrijf je eigen quicksort die precies doet wat jij wil. En dan kun je nog beter een bestaande quicksort ergens 'lenen' als je snel klaar wil zijn en dan pas je 'm aan dat 'ie een UDT- of Object- array/collection kan sorteren.

[ Voor 33% gewijzigd door RobIII op 23-07-2007 18:25 ]

[sturkel]

Ik heb het inmiddels werkend.
Hoe?
Via het voorbeeld van msdn: Q189631
probleem was dat na 1 de 10 gesorteerd werd, maar na een cint cast ook dit probleem verholpen.
hoop dat iemand er wat aan heeft.

[RobIII]

Nogal wiedes, als je strings sorteert dan krijg je:

• 1
• 10
• 11
• 12
• ...
• 2
• 20
• 21
• ...

Dit omdat "10" 'kleiner' is dan "2". Maar 10_int > 2_int. Je zult dus sowieso integers moeten sorteren en daarvoor gebruik je CInt om te casten ja. Maar wat heeft dat te maken met multidimensionele arrays sorteren? Dat was je vraag namelijk...
En dan nog: dan zou ik dus (weer) voor een UDT/Class gaan die gewoon de juiste types heeft, scheelt weer casten en dan had je dit hele probleem niet gehad (casten én multidimensionele arrays waren beide niet nodig geweest).

[ Voor 20% gewijzigd door RobIII op 24-07-2007 19:11 ]

[sturkel]

Heb ik wel nog een vraag over het sorteren van een array die udt's bevat.
Als ik verschillende arrays heb van een verschillend type udt, hoe kan ik dan een generieke functie maken die ik laat sorteren op een bepaalde kolom?
Wanneer je functie maakt moet de parameter van een bepaald type zijn, en dat is dan toch variabel omdat er verschillende udt's zijn.

[ATS]

Wacht even... Je wil een array waarin dingen van verschillende tyes inzitten sorteren, zonder dat je weet wat voor types het nu eigenlijk zijn? Dat gaat lastig worden... De types (udt's, classes, whatever) zullen toch iets gemeenschappelijks moeten hebben dat te vergelijken valt lijkt me?

Zelf vind ik het in één array stoppen van verschillende types nogal vies. In de meeste talen kan het niet eens (behalve via trucjes). Een uitzondering kán zijn als de klasses van elkaar overerven en je array van de basisklasse is, maar dan nog...

Misschien moet je eens uitleggen wat je wil bereiken, in plaats van welke oplossing jij voor ogen hebt en hoe je die moet maken?

[farlane]

ATS schreef op woensdag 25 juli 2007 @ 17:53:
De types (udt's, classes, whatever) zullen toch iets gemeenschappelijks moeten hebben dat te vergelijken valt lijkt me?

Ja een functie die twee van dat soort typen kan vergelijken. Lijkt me zelfs in VB nog wel te doen eigenlijk.

[sturkel]

Ik heb dus verschillende udt's die allen een bepaald veld bevatten (integer).
Ook heb ik evenveel array's van het betreffende type udt.
Nu wil ik de sorteerfunctie zo maken dat ik de te sorteren array meegeef aan de sorteerfunctie en de te sorteren kolom is dan een (mee te geven) veld uit de udt.
Hoop dat ik het zo duidelijk omschrijf.

[RobIII]

Ik zou (makkelijkst) een functie "CompareUDT" maken die afhankelijk van de parameter de juiste members compared.

[farlane]

Ik zou de compare algemeen laten en een functie scrijven die de goede property uit de UDT ophaalt.