dcsimg
Page 1 of 2 12 LastLast
Results 1 to 40 of 46

Thread: VB6 Dual-Pivot-QuickSort

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,403

    VB6 Dual-Pivot-QuickSort

    Just to throw something new (for VB6) into the ring of competing Sort-Algos...

    I've just finished porting (from Java-SourceCode) the relative new (Sep. 2009) Dual-Pivot-Algorithm, invented by
    Vladimir Yaroslavskiy, who has tuned good old QuickSort significantly, leaving over next to zero disadvantages.

    Here his posting, which finally led to the inclusion of this new algorithm into the official Java-SDK (used in Java.Array)
    http://permalink.gmane.org/gmane.com...ibs.devel/2628

    The source for this new Algo is contained in the attached Demo-Zip.

    Here's a Screenshot, which shows its performance with different kinds of Input-Data:
    With normal (random) Data it shows no disadvantages to a Standard-QuickSort -
    but offers huge improvements over "naive Quicksorts" when fed with "inconvenient data".

    As a side-note:
    HeapSort is outperformed in all tests quite significantly by the DualPivot-Algo...
    HeapSort is also beaten by the naive QuickSort in all tests, except the one with constant Data.



    Olaf
    Attached Files Attached Files
    Last edited by Schmidt; Nov 16th, 2014 at 01:40 AM.

  2. #2
    Fanatic Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    948

    Re: VB6 Dual-Pivot-QuickSort

    I make the Native-Extended Quick sort...With better performance from in some situation from native quicksort.




    Code:
    Public Sub NaiveQuickSortExtended(Arr() As Long, ByVal LB As Long, ByVal UB As Long)
    Dim M1 As Long, M2 As Long
    Dim Piv As Long, Tmp As Long '<- adjust types here, when switching to something different than Long
    
    
        
         
         If UB - LB = 1 Then
         M1 = LB: GoTo there4
         Else
           Tmp = (LB + UB) \ 2
         If Arr(Tmp) = Arr(LB) Then
           
         M2 = UB
         Tmp = LB
        Do
             Tmp = Tmp + 1
             If Tmp > M2 Then GoTo there3
         Loop Until Arr(Tmp) <> Arr(LB)
         End If
         End If
       
          M1 = LB
        M2 = UB
           Piv = Arr(Tmp) 'create the Pivot-Element
     
        Do
          Do While (Arr(M1) < Piv): M1 = M1 + 1: Loop
          Do While (Arr(M2) > Piv): M2 = M2 - 1: Loop
    
          If M1 <= M2 Then
            Tmp = Arr(M1): Arr(M1) = Arr(M2): Arr(M2) = Tmp 'swap
    
            M1 = M1 + 1
            M2 = M2 - 1
          End If
        Loop Until M1 > M2
     
        If LB < M2 Then NaiveQuickSortExtended Arr, LB, M2
        If M1 < UB Then NaiveQuickSortExtended Arr, M1, UB
        Exit Sub
    there3:
        For M1 = LB + 1 To UB - 1
            If Arr(M1) <> Arr(LB) Then Exit For
            Next M1
            
        If M1 < UB - 1 Then
            NaiveQuickSortExtended Arr(), M1, UB
        ElseIf M1 < UB Then
    there4:
        If Arr(M1) > Arr(UB) Then Tmp = Arr(M1): Arr(M1) = Arr(UB): Arr(UB) = Tmp
        Else
        If Arr(UB) < Arr(LB) Then Tmp = Arr(LB): Arr(LB) = Arr(UB): Arr(UB) = Tmp
        End If
    End Sub

    This is from Xp in Virtual Box..with no optimizations except "for fast code"..
    Name:  sort1.jpg
Views: 1359
Size:  62.4 KB
    Last edited by georgekar; Nov 16th, 2014 at 08:43 PM.

  3. #3
    Fanatic Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    948

    Re: VB6 Dual-Pivot-QuickSort

    I change the use of tmp so If we want we can change it to string without need for another var.

    Code:
    Public Sub NaiveQuickSortExtended(Arr() As Long, ByVal LB As Long, ByVal UB As Long)
    Dim M1 As Long, M2 As Long
    Dim Piv As Long, Tmp As Long '<- adjust types here, when switching to something different than Long
    
         If UB - LB = 1 Then
         M1 = LB: GoTo there4
         Else
           M1 = (LB + UB) \ 2
         If Arr(M1) = Arr(LB) Then
           
         M2 = UB
         M1 = LB
        Do
             M1 = M1 + 1
             If M1 > M2 Then GoTo there3
         Loop Until Arr(M1) <> Arr(LB)
         End If
         End If
       Piv = Arr(M1)
          M1 = LB
        M2 = UB
            'create the Pivot-Element
     
        Do
          Do While (Arr(M1) < Piv): M1 = M1 + 1: Loop
          Do While (Arr(M2) > Piv): M2 = M2 - 1: Loop
    
          If M1 <= M2 Then
            Tmp = Arr(M1): Arr(M1) = Arr(M2): Arr(M2) = Tmp 'swap
    
            M1 = M1 + 1
            M2 = M2 - 1
          End If
        Loop Until M1 > M2
     
        If LB < M2 Then NaiveQuickSortExtended Arr, LB, M2
        If M1 < UB Then NaiveQuickSortExtended Arr, M1, UB
        Exit Sub
    there3:
        For M1 = LB + 1 To UB - 1
            If Arr(M1) <> Arr(LB) Then Exit For
            Next M1
            
        If M1 < UB - 1 Then
            NaiveQuickSortExtended Arr(), M1, UB
        ElseIf M1 < UB Then
    there4:
        If Arr(M1) > Arr(UB) Then Tmp = Arr(M1): Arr(M1) = Arr(UB): Arr(UB) = Tmp
        Else
        If Arr(UB) < Arr(LB) Then Tmp = Arr(LB): Arr(LB) = Arr(UB): Arr(UB) = Tmp
        End If
    End Sub

  4. #4
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: VB6 Dual-Pivot-QuickSort

    Quote Originally Posted by georgekar View Post
    I change the use of tmp so If we want we can change it to string without need for another var.

    Code:
    Public Sub NaiveQuickSortExtended(Arr() As Long, ByVal LB As Long, ByVal UB As Long)
    Dim M1 As Long, M2 As Long
    Dim Piv As Long, Tmp As Long '<- adjust types here, when switching to something different than Long
    
         If UB - LB = 1 Then
         M1 = LB: GoTo there4
         Else
           M1 = (LB + UB) \ 2
         If Arr(M1) = Arr(LB) Then
           
         M2 = UB
         M1 = LB
        Do
             M1 = M1 + 1
             If M1 > M2 Then GoTo there3
         Loop Until Arr(M1) <> Arr(LB)
         End If
         End If
       Piv = Arr(M1)
          M1 = LB
        M2 = UB
            'create the Pivot-Element
     
        Do
          Do While (Arr(M1) < Piv): M1 = M1 + 1: Loop
          Do While (Arr(M2) > Piv): M2 = M2 - 1: Loop
    
          If M1 <= M2 Then
            Tmp = Arr(M1): Arr(M1) = Arr(M2): Arr(M2) = Tmp 'swap
    
            M1 = M1 + 1
            M2 = M2 - 1
          End If
        Loop Until M1 > M2
     
        If LB < M2 Then NaiveQuickSortExtended Arr, LB, M2
        If M1 < UB Then NaiveQuickSortExtended Arr, M1, UB
        Exit Sub
    there3:
        For M1 = LB + 1 To UB - 1
            If Arr(M1) <> Arr(LB) Then Exit For
            Next M1
            
        If M1 < UB - 1 Then
            NaiveQuickSortExtended Arr(), M1, UB
        ElseIf M1 < UB Then
    there4:
        If Arr(M1) > Arr(UB) Then Tmp = Arr(M1): Arr(M1) = Arr(UB): Arr(UB) = Tmp
        Else
        If Arr(UB) < Arr(LB) Then Tmp = Arr(LB): Arr(LB) = Arr(UB): Arr(UB) = Tmp
        End If
    End Sub
    where is the sort direction? Please make sorting routine be ready to use for beginner.

  5. #5
    Fanatic Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    948

    Re: VB6 Dual-Pivot-QuickSort

    Better, more optimizations...and I switch on the compiler optimizations...so now I get better numbers.


    @Jonney
    Take the Schmidt zip file and paste the NaiveQuickSortExtended in the bas file with the NaiveQuickSort sub. You can put this code the form among the other routines.

    Code:
    FillArray Arr, FillMode: DoEvents
      Timing True
        NaiveQuickSortExtended Arr, 0, UBound(Arr)
      Print , "Naive-QuickSort Extended", Timing
      If VerifyResults Then For i = 0 To UBound(Arr): Debug.Assert Arr(i) = ArrVerify(i): Next


    Code:
    Public Sub NaiveQuickSortExtended(Arr() As Long, ByVal LB As Long, ByVal UB As Long)
    Dim M1 As Long, M2 As Long
    Dim Piv As Long, Tmp As Long '<- adjust types here, when switching to something different than Long
    
         If UB - LB = 1 Then
         M1 = LB: GoTo there4
         Else
           M1 = (LB + UB) \ 2
                 If Arr(M1) = Arr(LB) Then
                    M2 = UB
                    M1 = LB
                    Do
                        M1 = M1 + 1
                        If M1 > M2 Then GoTo there3
                    Loop Until Arr(M1) <> Arr(LB)
                    Piv = Arr(M1)
                    If M1 > LB Then
                    If Arr(LB) > Piv Then Arr(M1) = Arr(LB): Arr(LB) = Piv: Piv = Arr(M1)
                    
                    End If
                Else
                    Piv = Arr(M1)
                    M1 = LB
                    Do While (Arr(M1) < Piv): M1 = M1 + 1: Loop
                End If
        End If
        M2 = UB
     
        Do
          Do While (Arr(M2) > Piv): M2 = M2 - 1: Loop
    
          If M1 <= M2 Then
            Tmp = Arr(M1): Arr(M1) = Arr(M2): Arr(M2) = Tmp 'swap
    
            M1 = M1 + 1
            M2 = M2 - 1
          End If
          If M1 > M2 Then Exit Do
          Do While (Arr(M1) < Piv): M1 = M1 + 1: Loop
        Loop
     
        If LB < M2 Then NaiveQuickSortExtended Arr, LB, M2
        If M1 < UB Then NaiveQuickSortExtended Arr, M1, UB
        Exit Sub
    there3:
        For M1 = LB + 1 To UB - 1
            If Arr(M1) <> Arr(LB) Then Exit For
            Next M1
            
        If M1 < UB - 1 Then
            NaiveQuickSortExtended Arr(), M1, UB
        ElseIf M1 < UB Then
    there4:
        If Arr(M1) > Arr(UB) Then Tmp = Arr(M1): Arr(M1) = Arr(UB): Arr(UB) = Tmp
        Else
        If Arr(UB) < Arr(LB) Then Tmp = Arr(LB): Arr(LB) = Arr(UB): Arr(UB) = Tmp
        End If
    End Sub

    Name:  sort3.jpg
Views: 1127
Size:  58.9 KB

  6. #6

    Thread Starter
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,403

    Re: VB6 Dual-Pivot-QuickSort

    Quote Originally Posted by Jonney View Post
    where is the sort direction? Please make sorting routine be ready to use for beginner.
    What about looping through your Array backwards (after it got sorted ascending)?

    Olaf

  7. #7
    Fanatic Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    948

    Re: VB6 Dual-Pivot-QuickSort

    This is the final code. I remove some old parts that isn't used any more and also I remove goto...It is faster than Dual-Pivot except in one test, Even Odd data, but is close to Dual-Pivot and not to naive-Quick Sort.
    The optimization now is clear in a position before the naive quick sort. In many cases is faster than quick sort.

    Code:
    Public Sub NaiveQuickSortExtended(Arr() As Long, ByVal LB As Long, ByVal UB As Long)
    Dim M1 As Long, M2 As Long
    Dim Piv As Long, Tmp As Long '<- adjust types here, when switching to something different than Long
         If UB - LB = 1 Then
         M1 = LB
          If Arr(M1) > Arr(UB) Then Tmp = Arr(M1): Arr(M1) = Arr(UB): Arr(UB) = Tmp
          Exit Sub
         Else
           M1 = (LB + UB) \ 2
                 If Arr(M1) = Arr(LB) Then
                    M2 = UB - 1
                    M1 = LB
                    Do
                        M1 = M1 + 1
                        If M1 > M2 Then
                            If Arr(UB) < Arr(LB) Then Tmp = Arr(LB): Arr(LB) = Arr(UB): Arr(UB) = Tmp
                            Exit Sub
                        End If
                    Loop Until Arr(M1) <> Arr(LB)
                    Piv = Arr(M1)
                    If M1 > LB Then If Arr(LB) > Piv Then Arr(M1) = Arr(LB): Arr(LB) = Piv: Piv = Arr(M1)
                Else
                    Piv = Arr(M1)
                    M1 = LB
                    Do While (Arr(M1) < Piv): M1 = M1 + 1: Loop
                End If
        End If
        M2 = UB
        Do
          Do While (Arr(M2) > Piv): M2 = M2 - 1: Loop
          If M1 <= M2 Then
            Tmp = Arr(M1): Arr(M1) = Arr(M2): Arr(M2) = Tmp 'swap
            M1 = M1 + 1
            M2 = M2 - 1
          End If
          If M1 > M2 Then Exit Do
          Do While (Arr(M1) < Piv): M1 = M1 + 1: Loop
        Loop
        If LB < M2 Then NaiveQuickSortExtended Arr, LB, M2
        If M1 < UB Then NaiveQuickSortExtended Arr, M1, UB
    End Sub

  8. #8

    Thread Starter
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,403

    Re: VB6 Dual-Pivot-QuickSort

    Quote Originally Posted by georgekar View Post
    This is the final code. I remove some old parts that isn't used any more and also I remove goto...It is faster than Dual-Pivot except in one test, Even Odd data, but is close to Dual-Pivot and not to naive-Quick Sort.
    The optimization now is clear in a position before the naive quick sort. In many cases is faster than quick sort.
    Thanks George - will take a better look at it the next days.

    Olaf

  9. #9
    Lively Member
    Join Date
    Mar 2012
    Posts
    68

    Re: VB6 Dual-Pivot-QuickSort

    Friends, tell me which one is the fastest sorting algorithms for string array?
    And also for the multidimensional string array?

  10. #10
    Fanatic Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    948

    Re: VB6 Dual-Pivot-QuickSort

    If you have unique keys to sort then quick sort without extensions is very fast. For multiple part key, if you have the first part unique then the others have no meaning, so you need only the last part to be unique....So we say that before choosing the right sort algorithm you have to realise how your data spread in your multi dimension array, defining a validaton procedure.
    Make the compare function from column a to b. If you find not equal before b do not go further and exit with result. If you find all equal including items in b column...that means you hit an error. The data are not acceptable to store. So your routine has to return two values, one for greater or lower, and one flag that say...not valid for unique keys.
    So with unique keys you have no situations as for even odd values (they aren't unique keys in Olaf example), or constant value. For safety I suggest the extented version...but you loose speed (you gain if there are equal keys..by a bad handle from other spot). Also with extended version you can check the key conflicts and get measures, like a spare part key that is always null, hidden, and before final to assign a value using the spare part key in item in LB as a counter.So the extended version can fix the keys to be unique at the sorting stage, but the user never see the hidden part. He get the sorting quick...and that is what we need...
    Last edited by georgekar; Nov 19th, 2014 at 05:52 AM.

  11. #11
    MS SQL Powerposter szlamany's Avatar
    Join Date
    Mar 2004
    Location
    CT
    Posts
    17,858

    Re: VB6 Dual-Pivot-QuickSort

    For descending - especially with multi keyed sorts - subtract the "key" from 9999999999's if it's a number, or for even cleaner results subtract each BYTE from "255" and sort that KEY. That does a descending sort with no changes to any other aspects of the sort or how you loop the data.

    For duplicate keys I always retain a "sequencer" column in each row. That value is used to break ties, and by doing so you have a STABLE sort for when a user is clicking and re-clicking different grid columns, for instance.

    *** Read the sticky in the DB forum about how to get your question answered quickly!! ***

    Please remember to rate posts! Rate any post you find helpful - even in old threads! Use the link to the left - "Rate this Post".

    Some Informative Links:
    [ SQL Rules to Live By ] [ Reserved SQL keywords ] [ When to use INDEX HINTS! ] [ Passing Multi-item Parameters to STORED PROCEDURES ]
    [ Solution to non-domain Windows Authentication ] [ Crazy things we do to shrink log files ] [ SQL 2005 Features ] [ Loading Pictures from DB ]

    MS MVP 2006, 2007, 2008

  12. #12
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: VB6 Dual-Pivot-QuickSort

    Quote Originally Posted by szlamany View Post
    For descending - especially with multi keyed sorts - subtract the "key" from 9999999999's if it's a number, or for even cleaner results subtract each BYTE from "255" and sort that KEY. That does a descending sort with no changes to any other aspects of the sort or how you loop the data.

    For duplicate keys I always retain a "sequencer" column in each row. That value is used to break ties, and by doing so you have a STABLE sort for when a user is clicking and re-clicking different grid columns, for instance.
    Good technique. How about an example?

  13. #13
    Fanatic Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    948

    Re: VB6 Dual-Pivot-QuickSort

    It is obvious...He take the sequencer column as the last part of the key so...this is always unique (auto increment)

  14. #14
    MS SQL Powerposter szlamany's Avatar
    Join Date
    Mar 2004
    Location
    CT
    Posts
    17,858

    Re: VB6 Dual-Pivot-QuickSort

    This link from two years ago talks about the sequencer for breaking ties

    http://www.vbforums.com/showthread.p...E)-within-sort

    *** Read the sticky in the DB forum about how to get your question answered quickly!! ***

    Please remember to rate posts! Rate any post you find helpful - even in old threads! Use the link to the left - "Rate this Post".

    Some Informative Links:
    [ SQL Rules to Live By ] [ Reserved SQL keywords ] [ When to use INDEX HINTS! ] [ Passing Multi-item Parameters to STORED PROCEDURES ]
    [ Solution to non-domain Windows Authentication ] [ Crazy things we do to shrink log files ] [ SQL 2005 Features ] [ Loading Pictures from DB ]

    MS MVP 2006, 2007, 2008

  15. #15
    Fanatic Member
    Join Date
    Aug 2013
    Posts
    806

    Re: VB6 Dual-Pivot-QuickSort

    This is a very nice and interesting bit of code, Olaf - thank you for sharing.

    One question. I notice that the presorted data sets (and occasionally the random data set) perform quite poorly relative to a naive QuickSort. This isn't the case in either the Java SDK implementation, or some of the C implementations I've looked at. Is there a way to reduce the Dual Pivot penalty for these data sets?

    Sample timings below, tested on a Win 7 box, older Core i5 processor (Clarkdale era), compiled EXE:

    Code:
    Random Data, Array-Size=2000000
    
    	DualPivot-QuickSort	352msec
    	Naive-QuickSort		283msec
    	Standard-HeapSort	729msec
    
     PresortedDesc Data, Array-Size=2000000
    
    	DualPivot-QuickSort	111msec
    	Naive-QuickSort		66msec
    	Standard-HeapSort	457msec
    
     PresortedAsc Data, Array-Size=2000000
    
    	DualPivot-QuickSort	104msec
    	Naive-QuickSort		59msec
    	Standard-HeapSort	461msec
    
     Even/Odd Data, Array-Size=2000000
    
    	DualPivot-QuickSort	20msec
    	Naive-QuickSort		170msec
    	Standard-HeapSort	232msec
    
     Constant Data, Array-Size=2000000
    
    	DualPivot-QuickSort	6msec
    	Naive-QuickSort		164msec
    	Standard-HeapSort	27msec
    These timing results could be due to branch prediction failure in older processors like this, which could make the issue hard to fix, but I thought I'd ask anyway.
    Check out PhotoDemon, a pro-grade photo editor written completely in VB6. (Full source available at GitHub.)

  16. #16
    Fanatic Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    948

    Re: VB6 Dual-Pivot-QuickSort

    @Tanner_H

    Can you test the NaiveQuickSortExtended from post #7

  17. #17
    Fanatic Member
    Join Date
    Aug 2013
    Posts
    806

    Re: VB6 Dual-Pivot-QuickSort

    Quote Originally Posted by georgekar View Post
    @Tanner_H

    Can you test the NaiveQuickSortExtended from post #7
    Definitely! Here are the updated results, with NaiveQuickSortExtended added to the mix. (I called it "Extended-QuickSort", so tabstops would align in the chart.)

    Code:
    Random Data, Array-Size=2000000
    	DualPivot-QuickSort	344msec
    	Naive-QuickSort		281msec
    	Extended-QuickSort	273msec
    	Standard-HeapSort	719msec
    
     PresortedDesc Data, Array-Size=2000000
    	DualPivot-QuickSort	113msec
    	Naive-QuickSort		70msec
    	Extended-QuickSort	70msec
    	Standard-HeapSort	453msec
    
     PresortedAsc Data, Array-Size=2000000
    	DualPivot-QuickSort	105msec
    	Naive-QuickSort		59msec
    	Extended-QuickSort	63msec
    	Standard-HeapSort	457msec
    
     Even/Odd Data, Array-Size=2000000
    	DualPivot-QuickSort	23msec
    	Naive-QuickSort		168msec
    	Extended-QuickSort	16msec
    	Standard-HeapSort	242msec
    
     Constant Data, Array-Size=2000000
    	DualPivot-QuickSort	4msec
    	Naive-QuickSort		164msec
    	Extended-QuickSort	4msec
    	Standard-HeapSort	27msec
    Check out PhotoDemon, a pro-grade photo editor written completely in VB6. (Full source available at GitHub.)

  18. #18
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: VB6 Dual-Pivot-QuickSort

    Here is my result on DELL Precision M4500 (2010 Product,Win7).

    Name:  SortResult.jpg
Views: 1229
Size:  78.8 KB
    Last edited by Jonney; Nov 20th, 2014 at 08:07 PM.

  19. #19
    Fanatic Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    948

    Re: VB6 Dual-Pivot-QuickSort


    I am happy. My last inspiration was to throw the pivot choice when a duplicate item founded in the start and then I do a search in the first items for a non duplicate, and if i found then i know that some items are the same and I do a swap if the not same item is less than the multiple item. So maybe all items are the same one, so i do n comparisons and not one swap and at the end i do an exit sub. So for constant data that is the most speedy approach. We see 12msec in Jonney's data. For Even/Odd data I think that I was lucky. Every time founded that the middle and first are equal, and the search stop to the second item, so a swap happen.. and the pivot now is the maximum "even" in the second position, so they start to swap....until all done..so in the next step we have nothing to do except to work as in constant data. My thought was for that two tests. But I see that has good times in every test...

  20. #20

    Thread Starter
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,403

    Re: VB6 Dual-Pivot-QuickSort

    Quote Originally Posted by Tanner_H View Post
    This is a very nice and interesting bit of code, Olaf - thank you for sharing.

    One question. I notice that the presorted data sets (and occasionally the random data set) perform quite poorly relative to a naive QuickSort. This isn't the case in either the Java SDK implementation, or some of the C implementations I've looked at. Is there a way to reduce the Dual Pivot penalty for these data sets?
    The Dual-Pivot-Algo has an interesting property - in that it needs even less comparisons than
    the (already very good in that regard) Standard-Quicksort.

    The following picture might underline that (in the Zip below I've included an appropriate Folder
    with the CC-Counter extended versions you see in the ScreenShot).
    (one can ignore the timings in this Shot - it's the Count of needed comparisons which is interesting there...)



    The Dual-Pivot achieves that at the cost of the Swaps (which it needs to perform in a greater
    amount - at least in the random case - than Standard-Quicksorts).

    And that's the main-reason (aside from a bit of tuning which was still missing in my first "straight port"), why the
    *VB-implemented* Standard-Quicksorts perform better in some cases (the naive one as well as Georges extended one).

    VB has a little disadvantage with its SafeArrays there, compared to "straight accessible" ones in C- or Java-Hotspot-
    compiled implementations. So that's the main-reason why in VB the Dual-Pivot doesn't outperform normal Quicksorts
    as it does in other languages - the less comparisons don't outweigh its larger swap-counts due to VBs lesser
    Swap-Performance.

    Nevertheless I've tuned the DualPivot a bit now, and achieve (on Long-Arrays) these Results:


    Algorithms which need less comparisons are often preferred - simply because they can be used then (as e.g. the
    qsort-function in the C-Runtime-Lib) for delegation to an (a bit more expensive) userdefined-compare-callback -
    and also because StringSorts (which are also expensive in their compares) profit very well from such an algo -
    even when the needed Swap-Counts are a bit higher... At least C (not sure about Java) allows direct String-Pointer-
    Swapping, so the costs of these swaps remain comparable to the swap-performance of Long-Arrays, whilst
    the time which is needed for the string-comparisons profits very much from the less compares of the DualPivot.

    In VB we can test and simulate this by introducing an additional Index-Array - performing an indirect sort.
    I've prepared a third Folder in the Zip, in which I've adapted Georges latest version and the DualPivot
    to indirect String-Sorting.

    The performance (which after my tuning was roughly on par with Georges Extended Quicksort in case of Longs)
    is now clearly better when Strings need to be sorted:


    Here's the Zip with the updated Version of the DualPivot, containing 3 Folders:
    .\DualPivotQuickSortCountComparisons
    .\DualPivotQuickSortLong
    .\DualPivotQuickSortString

    Edit, now also containing the Folder (and some slight changes for unique Index-Swaps):
    .\DualPivotQuickSortApplied
    to address the problem mentioned in the posting below (#21)

    DualPivotQuickSortComparisons.zip

    Olaf
    Last edited by Schmidt; Nov 23rd, 2014 at 11:15 PM.

  21. #21
    Fanatic Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    948

    Re: VB6 Dual-Pivot-QuickSort

    @Olaf,
    I have my reply here. I change also the rules, from a simple indexing array to go further, and I really want to see how fast this Double Pivot Quick Sort (DPQS) is. So I take my trusty myDoc class, that work as a document with paragraphs, dynamically arranged by using a doubly linked list. The task was hard because DPQS have some series of swap, for 3 and 4 items. So to maintain the doubly linked list it was necessary for that situations only to add another stage of sorting, the sorting of the list of that item that we have to unlink and then link to new positions in the document. I use the shell sort with expansion of a "position" array.

    Here are the results. For random strings (or paragraphs for document) we see that the simpler Quick Sort Extended are faster than Double Pivot Quick Sort.

    (i do a lot of changes to your program..sorry)

    Name:  n1.jpg
Views: 1119
Size:  67.3 KB
    Attached Files Attached Files
    Last edited by georgekar; Nov 23rd, 2014 at 03:02 PM.

  22. #22

    Thread Starter
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,403

    Re: VB6 Dual-Pivot-QuickSort

    Quote Originally Posted by georgekar View Post
    I have my reply here. I change also the rules, from a simple indexing array to go further, and I really want to see how fast this Double Pivot Quick Sort (DPQS) is.
    What was said (in that it needs less Comparisons, which is nice when sorting strings) remains unchanged -
    so when you apply this algo to a specific task *correctly*, then you will see appropriate results.

    Here's my take at it (applying the algo somewhat more efficient to your "Doc-Sorting-problem").
    At this occasion I did the same thing also with your extended Quicksort, so that both algorithms
    now sort your Doc about 6 times as fast.

    After a slight change (to ensure unique index-swaps) in the indirect Sorting, you now see these results:



    I've re-uploaded the Comparison-Zip with the indirect String-Sorting under the same link as in Post #20,
    but below it is again (now including also your TestFolder under \DualPivotQuickSortApplied):
    DualPivotQuickSortComparisons.zip

    And BTW George - your Doc-Class (Double-Linked-List) implementation is not really "enjoyable".
    It's an overcomplicated monster if you ask me, which could be reduced (using a decent Collection-
    Class) to about a fifth of its current code-volume - at least.


    Olaf
    Last edited by Schmidt; Nov 23rd, 2014 at 11:11 PM.

  23. #23
    PowerPoster
    Join Date
    Aug 2011
    Location
    B.C., Canada
    Posts
    2,887

    Re: VB6 Dual-Pivot-QuickSort

    Anyhow these are great sorting functions guys, thanks for sharing!

  24. #24
    Fanatic Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    948

    Re: VB6 Dual-Pivot-QuickSort

    @Olaf,
    I see your changes; You do a copy of data from linked list to a string array and the over time is due to link fixation on the last stage. We have a splendid speedy algo, but with one bad thing (not bad always, in this case is), we copy the data. If we use string compare in place, by using pointers, then we have no string transfer, and the comparison ends before the end of the reading (if routine found a non equal char early, so never copied entirely all the string data). This can be applied in any sort routine which deal with strings. You can see that I use a KeyStart variable to isolate first chars. So we have Mid$ that expect string expression, and copy the string to a temporary string and return the string to be compare. So with the copy that you did, in newest your version, in an array before sort starts, you gain time by using this manipulation once for each array item. Using the api to compare strings means that we can provide the right offset ...if each string is long enough. So we need a small code to decide if we can compare (perhaps we have an empty string or lower form KeyStart) and then we provide the right offset (keystart*2). An off topic here: The idea of Keystart is to split a string in two parts, the one part is a record with fix width fields, and the other part is a key with variable length. This key can be anything form simple chars to a strange output of a hash code. Also a variable key can serve as a path, so we can use the list as a tree list.
    I see that you remove the DPQS from myDoc class, and also the needed functions to operate the list. This changed routine (and missing from your last example, but is in mine in post 21) uses three swap routines. One for two items, one for three and one for four items. We can change the comparisons expressions and the swap routines with dummy routines that hold only a raiseevent command and we can make the realy good and fast DPQS sorting routine versatile. Using an array for index is not always a good idea (you have to lock the data), but for these examples are often a good choice.
    As for fatty code in myDoc class: This class is used here for the need of a document editor. Some day me or any of my small students (I teach children how to use software) can make a better code using a class.

    So it is nice to do a "competition" with you Olaf...this is a Greek way to "good fight", or as we can say "Ευ αγωνίζεσθαι".
    George


    Code:
    Const NORM_IGNORECASE As Long = &H1 'Ignore case.
    Const NORM_IGNOREKANATYPE As Long = &H40 'Do not differentiate between Hiragana and Katakana characters. Corresponding Hiragana and Katakana characters compare as equal.
    Const NORM_IGNORENONSPACE As Long = &H2 'Ignore nonspacing characters.
    Const NORM_IGNORESYMBOLS As Long = &H4 'Ignore symbols.
    Const NORM_IGNOREWIDTH As Long = &H8 'Do not differentiate between a single-byte character and the same character as a double-byte character.
    Const SORT_STRINGSORT As Long = &H1000 'Treat punctuation the same as symbols.
    
    Declare Function CompareStringW Lib "kernel32.dll" ( _
        ByVal Locale As Long, _
        ByVal dwCmpFlags As Long, _
        ByVal lpString1 As Long, _
        ByVal cchCount1 As Long, _
        ByVal lpString2 As Long, _
        ByVal cchCount2 As Long) As Long
    Public Function myCompEq(a$, b$) As Long
    dim clid ' leave it zero
    myCompEq = CompareStringW(cLid, 0, StrPtr(a$), -1, StrPtr(b$), -1)
    
    End Function

  25. #25
    MS SQL Powerposter szlamany's Avatar
    Join Date
    Mar 2004
    Location
    CT
    Posts
    17,858

    Re: VB6 Dual-Pivot-QuickSort

    Ok - I'm just way too busy these days and I've wanted to add a sort to your code and see how it performs. Just no time to do it...

    Since you mention you have students I'll post the sort code and if you all think it's worthy include it in your timings.

    I believe this is a Shell Sort (could be wrong - I've had it in my "tool box" since 1980 - back when I coded BASIC on PDP-11 minicomputers).

    With that said, it has GOTO statements. First challenge would be to get this code into the realm of proper conditional statements.

    I just copied it from a C++ routine of mine. Second challenge is to get it into a VB6-ish syntax. Shouldn't be that hard - it's a simple series of logic.

    Don't get overwhelmed by the key compare code. It's just a -1,0,1 value for <, = or >. And it's got a hack for keeping the list stable - not really needed.

    And it's not actually moving the data when sorting, it's creating a POINTER array that is in sorted order. Also, not really needed.

    Code:
    			int s1 = nKeywordskt;
    			int s2 = s1;
    			int s3 = 0, s4 = 0, s5 = 0, s6 = 0;
    			int a = 0;
    
    	 GP_SP_S1:
    
    			s1 = s1 / 2;
    			if (s1 == 0) {
    				goto GP_SP_S5;
    			}
    
    			s3 = s2 - s1;
    			s4 = 1;
    
    	 GP_SP_S2:
    			s5 = s4;
    
    	 GP_SP_S3:
    			s6 = s5 + s1;
    
    			a = mxstrcmp(strSearch, smarkerskt[sortptrs[s5-1]], emarkerskt[sortptrs[s5-1]], smarkerskt[sortptrs[s6-1]], emarkerskt[sortptrs[s6-1]]);
    			if (a == 0) {
    				if (sortptrs[s5-1] < sortptrs[s6-1]) {
    					a = -1;
    				} else {
    					a = 1;
    				}
    			}
    			if (a <= 0) {
    				goto GP_SP_S4;
    			}
    
    			j = sortptrs[s5-1];
    			sortptrs[s5-1] = sortptrs[s6-1];
    			sortptrs[s6-1] = j;
    
    			s5 = s5 - s1;
    
    			if (s5 >= 1) {
    				goto GP_SP_S3;
    			}
    
    	 GP_SP_S4:
    			s4 = s4 + 1;
    			if (s4 > s3) {
    				goto GP_SP_S1;
    			}
    
    			goto GP_SP_S2;
    
    	 GP_SP_S5:
    
    			s1 = 0; // dummy line

    *** Read the sticky in the DB forum about how to get your question answered quickly!! ***

    Please remember to rate posts! Rate any post you find helpful - even in old threads! Use the link to the left - "Rate this Post".

    Some Informative Links:
    [ SQL Rules to Live By ] [ Reserved SQL keywords ] [ When to use INDEX HINTS! ] [ Passing Multi-item Parameters to STORED PROCEDURES ]
    [ Solution to non-domain Windows Authentication ] [ Crazy things we do to shrink log files ] [ SQL 2005 Features ] [ Loading Pictures from DB ]

    MS MVP 2006, 2007, 2008

  26. #26

    Thread Starter
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,403

    Re: VB6 Dual-Pivot-QuickSort

    Quote Originally Posted by georgekar View Post
    I see your changes; You do a copy of data from linked list to a string array and the over time is due to link fixation on the last stage. We have a splendid speedy algo, but with one bad thing (not bad always, in this case is), we copy the data.
    No, we dont...
    if you look more carefully at the code I used in the updated Sort-Routines,
    I've used TetParaGraphKey instead of TextParagraph to provide the comparison-
    content in Arr() ... (and TetParaGraphKey respects your mKeyStart-Private-Variable)...

    Code:
      mKeystart = IIf(KeyStart < 0, 1, KeyStart)
     
      For i = 1 To UBound(Ind)
        Ind(i) = DocParaNext(Ind(i - 1))
        Arr(i) = TextParagraphKey(Ind(i))
      Next i
      If order1 <= 0 Then order1 = 1
      If order2 <= 0 Then order2 = i - 1
    
      DualPivotQuickSort Arr, Ind, order1, order2
      
      For i = 1 To UBound(Ind)
        DocParaNext(Ind(i - 1)) = Ind(i)
        DocParaBack(Ind(i)) = Ind(i - 1)
      Next i
      DocParaNext(Ind(UBound(Ind))) = 0
      DocParaBack(0) = Ind(UBound(Ind))
    Quote Originally Posted by georgekar View Post
    If we use string compare in place, by using pointers, then we have no string transfer, ...
    Feel free to switch back (using CompareStringW or whatever) to your former approach -
    but I can tell you already, that this will not beat the performance of the modification as
    it is in my latest update on your Doc-Class...

    Quote Originally Posted by georgekar View Post
    I see that you remove the DPQS from myDoc class, and also the needed functions to operate the list. This changed routine (and missing from your last example, but is in mine in post 21) uses three swap routines.
    These are not needed anymore - I really thought I made a point with my modification,
    which incorporated the *original* (indirect) Sort-Routines from the *.bas module,
    which are already generic enough with their indirection-array, to be applied to nearly
    all scenarios - without the need to reinvent "new Swap-Routines" for them...


    Quote Originally Posted by georgekar View Post
    As for fatty code in myDoc class: This class is used here for the need of a document editor.
    I've seen your stuff there - and it's not really how a TextBox-implementation should be done -
    for a more efficient one, you can always look at the implementation of the cwTextBox-widget
    in the GitHub vbWidgets-project (Link is on my site vbRichClient.com).

    I guess you want to implement your own WidgetSet - but your current encapsulation of "everything"
    in only one single "universal control" (in conjunction with your huge Doc-Class) is not really helpful
    along your way - you will loose yourself at some point in time in that huge single code-chunk,
    not going any further - if I may give a bit of advice - split it up into more (smaller) classes, which
    can stand on their own.

    A framework needs to be worked-up as a "stack of useful generic routines" - small pieces you
    build upon (in different Classes, which have their usage also elsewhere).

    Quote Originally Posted by georgekar View Post
    So it is nice to do a "competition" with you Olaf...this is a Greek way to "good fight", or as we can say "Ευ αγωνίζεσθαι".
    Glad you're taking no offense - wish this kind of "sports-spirit" would be more common
    in the forum here.

    Olaf

  27. #27
    Fanatic Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    948

    Re: VB6 Dual-Pivot-QuickSort

    @szlamany
    As I see you use smarkerskt[] for the start of the string and amarkerskt[] for the end. This means that you have somewhere in memory the actual non movable strings. I like goto...A goto may have one of two meanings...to skip code or to restart code.


    See my language and environment here. M2000 interpreter has GOTO and can use labels as names with : and numbers with 5 digits (without . But you can't use underscore..(but i can update the language it if you like)

    I make now a COMPARE function to compare string vars only (no expressions) and I make your code to M2000. Also I can make it for vb6 and we can see how speedy is..

  28. #28
    MS SQL Powerposter szlamany's Avatar
    Join Date
    Mar 2004
    Location
    CT
    Posts
    17,858

    Re: VB6 Dual-Pivot-QuickSort

    It would be great to see it in VB6 and get a timing on it. I use it in so many places.

    In my sample code I am sorting the words in a string of text - without moving the words around. So I have a pointer array that I move.

    It's in C++ for speed.

    If the timing of this sort algo is poor I will investigate others going forward - just that I've had this one for so long...

    *** Read the sticky in the DB forum about how to get your question answered quickly!! ***

    Please remember to rate posts! Rate any post you find helpful - even in old threads! Use the link to the left - "Rate this Post".

    Some Informative Links:
    [ SQL Rules to Live By ] [ Reserved SQL keywords ] [ When to use INDEX HINTS! ] [ Passing Multi-item Parameters to STORED PROCEDURES ]
    [ Solution to non-domain Windows Authentication ] [ Crazy things we do to shrink log files ] [ SQL 2005 Features ] [ Loading Pictures from DB ]

    MS MVP 2006, 2007, 2008

  29. #29
    Fanatic Member
    Join Date
    Aug 2013
    Posts
    806

    Re: VB6 Dual-Pivot-QuickSort

    @Olaf: thanks much for your explanation in #20. Very helpful, and great to know the advantages and preferred use-cases for the algorithm.
    Check out PhotoDemon, a pro-grade photo editor written completely in VB6. (Full source available at GitHub.)

  30. #30
    Fanatic Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    948

    Re: VB6 Dual-Pivot-QuickSort

    @Schmidt,
    You use TextParagraphKey, for me this is reading of the data and copy all (if keyStart=1), so you copy entire list in a fresh string array. That is no bad at all. You going back to your idea. My idea was to slow down everything to see what happen when a big load is there.
    As for my bloatware: This is my piece of work and any criticism is allowed, especially from someone how have spend time to make own same and better work. As you know every piece of code has own limitations. So for my code I know exactly the limitations, and the ugly things like the size of code. For the size I have no problem...for text, only from the vb scope, the compiler produce a very long machine code with thousands of bytes.. I use one fine tuning user control (and now the latest version has no shapes on it, it is a necked user control). And yes I split the functionality to some classes, one for textboxes, other for textviewer and edit, a nice one for drop down list. My basic scope was to not use any control from MS, and not needing for any com library for subclassing. So the only think that can "destroy" the happiness of good working is the break off vb6 runtime dll and maybe the changes of OS functions. Also my code is open source.

    off topic..................here
    You can find the implementation of my user control here in the M2000 environment. I use it for text editor, listbox, dropdown listbox with autocomplete function, textboxes, command buttons, and many other things, in forms that zoommed nicely. I use my own file selector, folder selector, font and color selector, and own msgbox. This language is for education for children and that children can open the file selector without delete anything (my file selectors do only that...select files. I can't understand why Microsoft give such rights to anyone to delete anything, or move anything, or run anything from a file selector...). And of course these selectors can be zoomed (and expanded if check that in setup). As you can understand my control is not a replacement of MS controls, but have things to offer that MS controls didn't have. So anyone can freely use it, or expand it as he like.
    I have the vbRichClient and the example of treetest. Very good. Some day I would like to put it in M2000...to open own windows but not this moment. I have to finish the help file. Where is the help file for vbRichClient? Is there any documentation?

  31. #31
    Fanatic Member DrUnicode's Avatar
    Join Date
    Mar 2008
    Location
    Natal, Brazil
    Posts
    631

    Re: VB6 Dual-Pivot-QuickSort

    Where is the help file for vbRichClient? Is there any documentation?
    You can get latest (31-Oct-2014) CHM manual of vbRichClient5 and vbWidgets at this link:
    http://cyberactivex.com/UnicodeTutor...m#vbRichClient
    Between the CHM files and the many demos you should be able to figure out how to use it.

  32. #32
    Fanatic Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    948

    Re: VB6 Dual-Pivot-QuickSort

    Thank you DrUnicode...
    also check No 85 Numeric TextBox, you can paste any char using context menu.

  33. #33
    Addicted Member
    Join Date
    Jan 2015
    Posts
    170

    Re: VB6 Dual-Pivot-QuickSort

    Code:
    Public Sub QSort2(ByRef key_arr() As Long, L As Long, R As Long)  '目前最快的qsort
        Dim i As Long, j As Long
        Dim x As Long, Swap As Long
        Const k As Long = 60
        If R - L <= k Then
            For i = L + 1 To R
                x = key_arr(i)
                    
                For j = i - 1 To L Step -1
                    If key_arr(j) <= x Then Exit For
                    key_arr(j + 1) = key_arr(j)
                Next
                key_arr(j + 1) = x
            Next
        Else
            x = key_arr((L + R) \ 2)
            i = L
            j = R
            Do While i <= j
                Do While key_arr(i) < x
                    i = i + 1
                Loop
                
                Do While key_arr(j) > x
                    j = j - 1
                Loop
               
                If i <= j Then
                    Swap = key_arr(i)
                    key_arr(i) = key_arr(j)
                    key_arr(j) = Swap
                    i = i + 1
                    j = j - 1
                End If
            Loop
    
            '递归方法
            If L < j Then
                Do While key_arr(j) = x
                    j = j - 1
                    If j = L Then Exit Do
                Loop
                Call QSort2(key_arr, L, j)
            End If
            If i < R Then
                Do While key_arr(i) = x
                    i = i + 1
                    If i = R Then Exit Do
                Loop
                Call QSort2(key_arr, i, R)
            End If
        End If
    End Sub

  34. #34
    Addicted Member
    Join Date
    Jan 2015
    Posts
    170

    Re: VB6 Dual-Pivot-QuickSort

    qsort.c -> vb6 by acme_pjz @ www.vbgood.com
    Code:
    Option Explicit
    
    #Const UseMSVCRT = 1
    
    #If UseMSVCRT Then
    
    '/***
    '*qsort(base, num, wid, comp) - quicksort function for sorting arrays
    '*
    '*Purpose:
    '*   quicksort the array of elements
    '*   side effects:  sorts in place
    '*   maximum array size is number of elements times size of elements,
    '*   but is limited by the virtual address space of the processor
    '*
    '*Entry:
    '*   char *base = pointer to base of array
    '*   size_t num  = number of elements in the array
    '*   size_t width = width in bytes of each array element
    '*   int (*comp)() = pointer to function returning analog of strcmp for
    '*           strings, but supplied by user for comparing the array elements.
    '*           it accepts 2 pointers to elements.
    '*           Returns neg if 1<2, 0 if 1=2, pos if 1>2.
    '*
    '*Exit:
    '*   returns void
    '*
    '*Exceptions:
    '*   Input parameters are validated. Refer to the validation section of the function.
    '*
    '*******************************************************************************/
    
    Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
    Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
    Private Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Long
    Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
    
    Private m_bCode(255) As Byte, m_hMod As Long, m_lpFunc As Long
    Private m_lpObjPtr As Long, m_nUserData As Long
    
    #End If
    
    Public Function Compare(ByVal Index1 As Long, ByVal Index2 As Long, ByVal nUserData As Long) As Long
    'default implementation (???)
    If Index1 < Index2 Then Compare = -1 Else _
    If Index1 > Index2 Then Compare = 1 Else Compare = 0
    End Function
    
    Friend Sub QuickSort(idxArray() As Long, ByVal nStart As Long, ByVal nEnd As Long, Optional ByVal obj As ISort2, Optional ByVal nUserData As Long, Optional ByVal nLimit As Long = 8)
    '///check
    If nEnd - nStart <= 1 Then Exit Sub
    If obj Is Nothing Then Set obj = Me
    '///
    #If UseMSVCRT Then
    If m_lpFunc Then
    m_lpObjPtr = ObjPtr(obj)
    m_nUserData = nUserData
    CallWindowProc VarPtr(m_bCode(0)), VarPtr(idxArray(nStart)), nEnd - nStart + 1, m_lpFunc, 0
    Exit Sub
    End If
    #Else
    '////////////////////////////////TODO:translate qsort.c into VB
    Dim i As Long, j As Long, k As Long 'temp
    Dim nMid As Long '/* points to middle of subarray */
    Dim lpStart As Long, lpEnd As Long '/* traveling pointers for partition step */
    Dim nSize As Long '/* size of the sub-array */
    Dim nStartStack(31) As Long, nEndStack(31) As Long, nStack As Long '/* stack for saving sub-array to be processed */
    '/* this entry point is for pseudo-recursion calling: setting
    '   lo and hi and jumping to here is like recursion, but stkptr is
    '   preserved, locals aren't, so we preserve stuff on the stack */
    Recurse:
    'size = (hi - lo) / width + 1;        /* number of el's to sort */
    nSize = nEnd - nStart + 1
    '/* below a certain size, it is faster to use a O(n^2) sorting method */
    If nSize <= nLimit Then
    'shortsort
    If nSize > 1 Then
      Do
       lpStart = nStart
       i = idxArray(lpStart)
       For lpEnd = nStart + 1 To nEnd
        j = idxArray(lpEnd)
        If obj.Compare(j, i, nUserData) > 0 Then lpStart = lpEnd: i = j
       Next lpEnd
       If lpStart < nEnd Then idxArray(lpStart) = idxArray(nEnd): idxArray(nEnd) = i
       nEnd = nEnd - 1
      Loop While nEnd > nStart
    End If
    Else
    '    /* First we pick a partitioning element.  The efficiency of the
    '       algorithm demands that we find one that is approximately the median
    '       of the values, but also that we select one fast.  We choose the
    '       median of the first, middle, and last elements, to avoid bad
    '       performance in the face of already sorted data, or data that is made
    '       up of multiple sorted runs appended together.  Testing shows that a
    '       median-of-three algorithm provides better performance than simply
    '       picking the middle element for the latter case. */
    '    mid = lo + (size / 2) * width;      /* find middle element */
        nMid = nStart + nSize \ 2
    '
    '    /* Sort the first, middle, last elements into order */
    '    if (__COMPARE(context, lo, mid) > 0) swap(lo, mid, width);
        i = idxArray(nStart): j = idxArray(nMid)
        If obj.Compare(i, j, nUserData) > 0 Then idxArray(nStart) = j: idxArray(nMid) = i
    '    if (__COMPARE(context, lo, hi) > 0) swap(lo, hi, width);
        i = idxArray(nStart): j = idxArray(nEnd)
        If obj.Compare(i, j, nUserData) > 0 Then idxArray(nStart) = j: idxArray(nEnd) = i
    '    if (__COMPARE(context, mid, hi) > 0) swap(mid, hi, width);
        i = idxArray(nMid): j = idxArray(nEnd)
        If obj.Compare(i, j, nUserData) > 0 Then idxArray(nMid) = j: idxArray(nEnd) = i
    '
    '    /* We now wish to partition the array into three pieces, one consisting
    '       of elements <= partition element, one of elements equal to the
    '       partition element, and one of elements > than it.  This is done
    '       below; comments indicate conditions established at every step. */
    '
    '    loguy = lo;
    '    higuy = hi;
        lpStart = nStart
        lpEnd = nEnd
    '
    '    /* Note that higuy decreases and loguy increases on every iteration,
    '       so loop must terminate. */
    '    for (;;) {
        Do
    '        /* lo <= loguy < hi, lo < higuy <= hi,
    '           A[i] <= A[mid] for lo <= i <= loguy,
    '           A[i] > A[mid] for higuy <= i < hi,
    '           A[hi] >= A[mid] */
    '
    '        /* The longd loop is to avoid calling comp(mid,mid), since some
    '           existing comparison funcs don't work when passed the same
    '           value for both pointers. */
            i = idxArray(nMid)
    '        if (mid > loguy) {
    '            do  {
    '                loguy += width;
    '            } while (loguy < mid && __COMPARE(context, loguy, mid) <= 0);
    '        }
            If nMid > lpStart Then
             Do
              lpStart = lpStart + 1
              j = idxArray(lpStart)
              If lpStart >= nMid Then Exit Do
             Loop While obj.Compare(j, i, nUserData) <= 0
            End If
    '        if (mid <= loguy) {
    '            do  {
    '                loguy += width;
    '            } while (loguy <= hi && __COMPARE(context, loguy, mid) <= 0);
    '        }
            If nMid <= lpStart Then
             Do
              lpStart = lpStart + 1
              If lpStart > nEnd Then Exit Do
              j = idxArray(lpStart)
             Loop While obj.Compare(j, i, nUserData) <= 0
            End If
    '
    '        /* lo < loguy <= hi+1, A[i] <= A[mid] for lo <= i < loguy,
    '           either loguy > hi or A[loguy] > A[mid] */
    '
    '        do  {
    '            higuy -= width;
    '        } while (higuy > mid && __COMPARE(context, higuy, mid) > 0);
            Do
             lpEnd = lpEnd - 1
             k = idxArray(lpEnd)
             If lpEnd <= nMid Then Exit Do
            Loop While obj.Compare(k, i, nUserData) > 0
    '
    '        /* lo <= higuy < hi, A[i] > A[mid] for higuy < i < hi,
    '           either higuy == lo or A[higuy] <= A[mid] */
    '
    '        if (higuy < loguy)
    '            break;
            If lpEnd < lpStart Then Exit Do
    '
    '        /* if loguy > hi or higuy == lo, then we would have exited, so
    '           A[loguy] > A[mid], A[higuy] <= A[mid],
    '           loguy <= hi, higuy > lo */
    '
    '        swap(loguy, higuy, width);
            If lpEnd > lpStart Then idxArray(lpStart) = k: idxArray(lpEnd) = j
    '
    '        /* If the partition element was moved, follow it.  Only need
    '           to check for mid == higuy, since before the swap,
    '           A[loguy] > A[mid] implies loguy != mid. */
    '
    '        if (mid == higuy)
    '            mid = loguy;
            If nMid = lpEnd Then nMid = lpStart
    '
    '        /* A[loguy] <= A[mid], A[higuy] > A[mid]; so condition at top
    '           of loop is re-established */
    '    }
        Loop
    '
    '    /*     A[i] <= A[mid] for lo <= i < loguy,
    '           A[i] > A[mid] for higuy < i < hi,
    '           A[hi] >= A[mid]
    '           higuy < loguy
    '       implying:
    '           higuy == loguy-1
    '           or higuy == hi - 1, loguy == hi + 1, A[hi] == A[mid] */
    '
    '    /* Find adjacent elements equal to the partition element.  The
    '       longd loop is to avoid calling comp(mid,mid), since some
    '       existing comparison funcs don't work when passed the same value
    '       for both pointers. */
    '
    '    higuy += width;
        lpEnd = lpEnd + 1
    '    if (mid < higuy) {
    '        do  {
    '            higuy -= width;
    '        } while (higuy > mid && __COMPARE(context, higuy, mid) == 0);
    '    }
        i = idxArray(nMid)
        If nMid < lpEnd Then
         Do
          lpEnd = lpEnd - 1
          If lpEnd <= nMid Then Exit Do
         Loop While obj.Compare(idxArray(lpEnd), i, nUserData) = 0
        End If
    '    if (mid >= higuy) {
    '        do  {
    '            higuy -= width;
    '        } while (higuy > lo && __COMPARE(context, higuy, mid) == 0);
    '    }
        If nMid >= lpEnd Then
         Do
          lpEnd = lpEnd - 1
          If lpEnd <= nStart Then Exit Do
         Loop While obj.Compare(idxArray(lpEnd), i, nUserData) = 0
        End If
    '
    '    /* OK, now we have the following:
    '          higuy < loguy
    '          lo <= higuy <= hi
    '          A[i]  <= A[mid] for lo <= i <= higuy
    '          A[i]  == A[mid] for higuy < i < loguy
    '          A[i]  >  A[mid] for loguy <= i < hi
    '          A[hi] >= A[mid] */
    '
    '    /* We've finished the partition, now we want to sort the subarrays
    '       [lo, higuy] and [loguy, hi].
    '       We do the smaller one first to minimize stack usage.
    '       We only sort arrays of length 2 or more.*/
    '
    '    if ( higuy - lo >= hi - loguy ) {
        If lpEnd - nStart >= nEnd - lpStart Then
    '        if (lo < higuy) {
    '            lostk[stkptr] = lo;
    '            histk[stkptr] = higuy;
    '            ++stkptr;
    '        }                           /* save big recursion for later */
            If nStart < lpEnd Then
             nStartStack(nStack) = nStart
             nEndStack(nStack) = lpEnd
             nStack = nStack + 1
            End If
    '        if (loguy < hi) {
    '            lo = loguy;
    '            goto recurse;           /* do small recursion */
    '        }
            If lpStart < nEnd Then
             nStart = lpStart
             GoTo Recurse
            End If
    '    }
        Else
    '    else {
    '        if (loguy < hi) {
    '            lostk[stkptr] = loguy;
    '            histk[stkptr] = hi;
    '            ++stkptr;               /* save big recursion for later */
    '        }
            If lpStart < nEnd Then
             nStartStack(nStack) = lpStart
             nEndStack(nStack) = nEnd
             nStack = nStack + 1
            End If
    '
    '        if (lo < higuy) {
    '            hi = higuy;
    '            goto recurse;           /* do small recursion */
    '        }
            If nStart < lpEnd Then
             nEnd = lpEnd
             GoTo Recurse
            End If
    '    }
        End If
    End If
    '/* We have sorted the array, except for any pending sorts on the stack.
    '   Check if there are any, and do them. */
    nStack = nStack - 1
    If nStack >= 0 Then
    nStart = nStartStack(nStack)
    nEnd = nEndStack(nStack)
    GoTo Recurse '/* pop subarray from stack */
    End If
    'else
    '    return;                 /* all subarrays done */
    '////////////////////////////////
    #End If
    End Sub
    
    #If UseMSVCRT Then
    
    Private Sub Class_Initialize()
    Dim s As String
    '///
    m_hMod = LoadLibrary("msvcrt.dll")
    m_lpFunc = GetProcAddress(m_hMod, "qsort")
    '///
    s = "89 E0 E8 00 00 00 00 83 04 24 15 6A 04 FF 70 08" + _
    "FF 70 04 FF 50 0C 83 C4 10 C2 10 00 6A 00 89 E0" + _
    "8B 15 ObjPtr 50 FF 35 UserData 8B 48 0C" + _
    "8B 40 08 FF 31 FF 30 8B 0A 52 FF 51 1C 58 C3"
    s = Replace(s, "ObjPtr", ReverseHex(VarPtr(m_lpObjPtr)))
    s = Replace(s, "UserData", ReverseHex(VarPtr(m_nUserData)))
    CodeFromString s, m_bCode
    End Sub
    
    Private Sub Class_Terminate()
    FreeLibrary m_hMod
    End Sub
    
    Private Sub CodeFromString(ByVal s As String, ByRef b() As Byte)
    Dim m As Long, i As Long
    s = Replace(s, " ", "")
    s = Replace(s, ",", "")
    m = Len(s) \ 2
    For i = 0 To m - 1
    b(i) = Val("&H" + Mid(s, i + i + 1, 2))
    Next i
    End Sub
    
    Private Function ReverseHex(ByVal n As Long) As String
    Dim s As String
    s = Right("00000000" + Hex(n), 8)
    ReverseHex = Mid(s, 7, 2) + Mid(s, 5, 2) + Mid(s, 3, 2) + Mid(s, 1, 2)
    End Function
    
    #End If

  35. #35
    Addicted Member
    Join Date
    Jan 2015
    Posts
    170

    Re: VB6 Dual-Pivot-QuickSort

    This QuickSort by someone at vbGood is the most fast quick sort i have ever seen

    if sorting a string array, should use string pointer to swap, and change the first parameter to string()

    Code:
    Public Sub QSort2(ByRef key_arr() As Long, ByVal l As Long, ByVal r As Long)
        Dim i As Long, j As Long
        Dim x As Long, Swap As Long
        Const k As Long = 60
        If r - l <= k Then
            For i = l + 1 To r
                x = key_arr(i)
                For j = i - 1 To l Step -1
                    If key_arr(j) <= x Then Exit For
                    key_arr(j + 1) = key_arr(j)
                Next
                key_arr(j + 1) = x
            Next
        Else
            x = key_arr((l + r) \ 2)
            i = l
            j = r
            Do While i <= j
                Do While key_arr(i) < x
                    i = i + 1
                Loop
                Do While key_arr(j) > x
                    j = j - 1
                Loop
                If i <= j Then
                    Swap = key_arr(i)
                    key_arr(i) = key_arr(j)
                    key_arr(j) = Swap
                    i = i + 1
                    j = j - 1
                End If
            Loop
            If l < j Then
                Do While key_arr(j) = x
                    j = j - 1
                    If j = l Then Exit Do
                Loop
                Call QSort2(key_arr, l, j)
            End If
            If i < r Then
                Do While key_arr(i) = x
                    i = i + 1
                    If i = r Then Exit Do
                Loop
                Call QSort2(key_arr, i, r)
            End If
        End If
    End Sub

  36. #36
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: VB6 Dual-Pivot-QuickSort

    Quote Originally Posted by loquat View Post
    This QuickSort by someone at vbGood is the most fast quick sort i have ever seen

    if sorting a string array, should use string pointer to swap, and change the first parameter to string()
    Please provide evidence for the claim of "the most fast quick sort" such as testing results instead of just a piece of snippets.

  37. #37
    Addicted Member
    Join Date
    Jan 2015
    Posts
    170

    Re: VB6 Dual-Pivot-QuickSort

    Quote Originally Posted by Jonney View Post
    Please provide evidence for the claim of "the most fast quick sort" such as testing results instead of just a piece of snippets.
    I would like to.

    in IDE, most evironment i used in, vice VBA
    Name:  sorting.png
Views: 552
Size:  24.1 KB

    in exe
    Name:  sort compiled.png
Views: 520
Size:  24.0 KB
    Attached Files Attached Files
    Last edited by loquat; Jul 23rd, 2017 at 11:39 PM. Reason: Add project

  38. #38
    Addicted Member
    Join Date
    Jan 2015
    Posts
    170

    Re: VB6 Dual-Pivot-QuickSort

    by the way, i claim that with no offense.
    and i have added words like "i have ever seen"
    so do not judge me a lot, i only wanna share what i think is the best.
    if u guys have better option, it will be nice if u share it to me.

    regards
    loquat

  39. #39

    Thread Starter
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,403

    Re: VB6 Dual-Pivot-QuickSort

    Quote Originally Posted by loquat View Post
    by the way, i claim that with no offense.
    and i have added words like "i have ever seen"
    so do not judge me a lot, i only wanna share what i think is the best.
    if u guys have better option, it will be nice if u share it to me.
    I'd say, that the Dual-Pivot is the better option, when you want a "general purpose algo" - and on my machine (with 2Mio 32Bit-Long-Arrays)
    it is only ~10% slower (223msec) than the QSort2 you've posted (206msec), which is simply a naive QS, extended by the usual insertion-sort at the top).

    Please read my post #20 again, where I've written about the amount of comparisons ...
    (the Dual-Pivot is the algo which needs the least comparisons to achieve a sorted result on the most common case with random data).

    So, with String-Data or when CallBack-Delegations to a Comparer-function are used, the DualPivot is hard to beat.

    If you have only Integer-Arrays to sort (easy to compare, easy to swap even ByValue),
    the choosen algorithm does not really make that much of a difference, becaue:
    - 1Mio random 32Bit-Integers will be sorted in about 100-200msec on current CPUs (with any QuickSort)
    - whereas, when 1Mio random Strings will take 1.5-3seconds (and the User has to wait about factor 15 longer for the result) -
    . algorithms which perform less comparisons can shape off some time "you really feel".

    I'd suggest that you make a few tests with String-Arrays (which do a pointer-swap, or use an indirect sort).

    Olaf

  40. #40
    Hyperactive Member
    Join Date
    Jul 2007
    Location
    Essex, UK.
    Posts
    469

    Re: VB6 Dual-Pivot-QuickSort

    Olaf you once showed me how to use StrCmpLogicalW(StrPtr(S1),StrPtr(S2)) with a standard QuickSort.

    I would now like to use the DualPivot-Quicksort and have tried replacing all the comparisons (If M1<M2) etc with the StrCmpLogicalW equivalent but it is VERY slow. Can you show how you would do it please.

    Steve.

Page 1 of 2 12 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width