Δευτέρα 17 Νοεμβρίου 2014

Η επέκταση της Quick Sort

Quick Sort extended
ή ελληνικά Μέθοδος ταξινόμησης Quick Sort με μια παραλλαγή δική μου!

Δημοσιεύτηκε εδώ: http://www.vbforums.com/showthread.php?781043-VB6-Dual-Pivot-QuickSort

Η ταξινόμηση τύπου Quick Sort είναι πολύ γρήγορη αλλά έχει μερικά μελανά σημεία. Μπορεί να γίνει πολύ χρονοβόρα αν υπάρχουν ορισμένες συνθήκες. Όπως αν έχουμε εναλλαγή 1 και 0 σε έναν πίνακα, ή αν έχουμε για μεγάλη έκταση μια αντιγραφή από το ίδιο στοιχείο (σταθερή τιμή).

Η πρότασή μου περιλαμβάνει μια προσθήκη στο κώδικα της ταξινόμησης Quick Sort, όπου κάποιες φορές την κάνει πιο γρήγορη. Σε κάθε περίπτωση το πρόβλημα των εναλλαγών 1 και 0 καθώς και των σταθερών τιμών το ξεπερνάει σε ελάχιστο χρόνο.

Η προσθήκη δεν επιβαρύνει πάντα αλλά και ωφελεί. Και αυτό γιατί όταν βρει τον ενδιάμεσο ίδιο με τον πρώτο αλλάζει στρατηγική και ελέχγει πόσα διαφορετικά στοιχεία υπάρχουν στην αρχή του τμήματος που ταξινομεί. Ενδέχεται να μην βρει κανένα...και απλά τερματίζει. Αν βρει ένα τότε κοιτάει αν είναι η θέση του εκεί και το αλλάζει αν όχι και πάλι τερματίζει. Και στις δυο περιπτώσεις δεν εκτελεί τον κανονικό κώδικα της quick sort.

Μια ενδιάμεση περίπτωση είναι να βρει αρκετά στοιχεία όμοια στην αρχή μόνο. Τότε κοιτάει αν η θέση αυτού του μοναδικού (για την ώρα) στοιχείου πρέπει να αλλαχτεί με το πρώτο από τα όμοια και αν ναι την αλλάζει, και συνεχίζει τον κανονικό αλγόριθμο χωρίς το πρώτο κλάδο του, την εύρεση του πρώτου μεγαλύτερου, μετά τον πρώτο στη λίστα. Έτσι στην ουσία αντί να βρει το πρώτο μεγαλύτερο και να αφήσει μια σειρά όμοια μετά από αυτό...τα περνάει στα μικρότερα. Και αυτή είναι η περίπτωση που το κάνει ταχύτερο από την βασική Quick Sort.

Μια "πονηριά" εδώ είναι ότι άλλαξα την θέση του πρώτου κλάδου στον βασικό βρόγχο της Quick Sort για να κερδίσω ταχύτητα, και έβαλα ένα αντίγραφο αυτού στη περίπτωση που δεν κάνω αναζήτηση για όμοια.

Σημαντικό σημείο είναι το πότε κάνουμε αναζήτηση για όμοια. Αν γίνεται συνέχεια τότε θα πέσει η ταχύτητα. Αποφάσισα αυτό να το κάνω μόνο όταν το μεσαίο στοιχείο είναι ίδιο με το πρώτο. Σε κάθε άλλη περίπτωση θα πιαστεί το "πρόβλημα" επειδή βάσει σχεδίασης η Quick Sort τεμαχίζει τη λίστα σε δυο και μετά δύο σε κάθε δυο οπότε, εφόσον υπάρχει ίδια τιμή, θα πέσουμε σε μια από τις δυο περιπτώσεις που βοηθάει η προσθήκη...να έχουμε μόνο δυο στοιχεία ή το μεσαίο στοιχείο να είναι ίδιο με το πρώτο. Στη πρώτη περίπτωση ελέγχει αν θα κάνει μετάθεση και τερματίζει και στην δεύτερη ξεκινάει την έρευνα για την ομάδα των ομοίων.

αν παραστήσουμε τα όμοια με 1 και θεωρήσουμε αυτή την λίστα
11111101111001001
τότε  θα πάρει το σύστημα την μεσαία τιμή (εδώ 1) θα δει ότι είναι όμοια
και θα την παρατήσει! Θα ξεκινήσει από την αρχή+1 και θα κοιτάξει που σταματούν τα όμοια! θα βρει το 0 και θα το αλλάξει..
01111111111111001
οπότε το 0 είναι σε σωστή θέση και συνεχίζει την κανονική quick sort με μεσαία τιμή το 1 στη θέση 7.
Ας το δούμε αναλύτικά:
ελέχγει από το 17 (το τέλος) αν έχει τιμή μεγαλύτερη από το 1, δεν έχει και πάει για αλλαγή (τζούφια) και αλλάζει τους δείκτες 8 και 16.
τώρα ελέγχει αν στο 8 υπάρχει μικρότερη τιμή...δεν υπάρχει
πάμε για το 16 αν υπάρχει μεγαλύτερη τιμή...δεν υπάρχει...και αλλάζει τιμές
01111110111111011 και έχει δείκτες 9 και 15
στο 9 δεν βρίσκει μικρότερη τιμή...στο δεκαπέντε δεν βρίσκει μεγαλύτερη
κάνει αλλαγή
01111110011111111 και έχει δείκτες 10 και 14
τώρα κάνει τζούφιες αλλαγές ...και αλλάζει δείκτες 11 και 13, 12 και 12 και 13 και 11...
τώρα βγαίνουμε από την επανάληψη και πάμε σε δυο κλήσεις τις ίδιας ρουτίνας (αναδρομική διαδικασία), όπου οι λίστες είναι
1 εως 11 και 13 εως 17 (το 12 είναι στην θέση του...)
01111110011 και 111111
η δεύτερη λίστα με τη προσθήκη που έχω βάλει με μια εξέταση ότι δεν υπάρχει άλλη τιμή από 1 τερματίζει (δεν κάνει καθόλου αλλαγές).
Η πρώτη λίστα δίνει μεσαίο  1 στην θέση 6 είναι διαφορετικός από το στοιχείο στη θέση 0 οπότε πάμε σε κανονική εκτέλεση της quicksort με δείκτες 1 και 11
βρίσκει ότι στην 1 έχει μικρότερη τιμη και αυξάνει το δείκτη σε 2
τώρα κοιτάει στο 11 δεν βρίσκει μεγαλύτερη τιμή και πάει σε τζούφια αλλαγή...και δείκτες 3 και 10...ομοίως και πάμε σε 4 και 9..εδώ δεν έχουμ τζούφια αλλαγή:
01101110111  και δείκτες 5 και 8 πάλι αλλαγή
01100111111 και 6 και 7...τζούφια αλλαγή και 7 και 6 (7>6 βγαίνουμε από την επανάληψη).
πάμε πάλι σε δυο λίστες
την 1 εως 6 και την 7 εως 11
011001 και 11111 η δεύτερη με την προσθήκη κάνει απλά έναν έλεγχο και τερματίζει χωρίς καθόλους αλλαγές.
η δεύτερη  πέρνει μεσαίο το 3 δηλαδή το 1 και φτιάχνει δείκτες 1 και 6
στο 1 έχει μικρότερο και το αφήνει πάμε σε 2 και 6 και κάνουμε τζούφια αλλαγή...και πάμε σε 3 και 5...όπου
010011 και πάμε στα 4 και 4 το 4 γίνεται 5 (αφου το 0<1) και δεν γίνεται
καμία αλλαγή και βγαίνουμε σε δυο λίστες 1 - 4 και 5-6
0100 και 11 η δεύτερη λιστα είναι η περίπτωση που εξετάζει η επέκταση που έχω βάλει και βγαίνει αμέσως από την ρουτίνα.
τώρα βρίσκει το μεσαίο το 2 και παίρνει το 1 και φτιάχνει τους δείκτες 1 και 4
ο δείκτης 1 γίνεται 2 και κάνει την πρώτη αλλαγή μεταξύ 2 και 4
0001 και αλλάζει τους δείκτες σε 3 και 3...και κάνει μια ζούφια αλλαγή και 4 και 2 οι δείκτες
βγάζει μόνο μια λίστα την 00 (το τελευταίο 0 και το 1 τα θεωρεί στη θέση τους ο αλγόριθμος και είναι) και καλεί πάλι την ρουτίναι, η οποία βάση της προσθήκης την τερματίζει αμέσως..

(αν δεν υπήρχε η προσθήκη θα έβγαζε το μεσαίο, στα δυο στοιχεία είναι το πρώτο, το 0, και θα έβγαζε δυο δείκτες 1 και 2, θα έκανε μια τζούφια αλλαγή, θα πήγαινε τους δείκτες στο 2 και 1 και δεν θα καλούσε άλλη λίστα).

Όπως φάνηκε από τα παραπάνω όποτε δυο στοιχεία είναι ίδια η quicksort κάνει τζούφιες αλλαγές. Με την προσθήκη γλιτώνουμε πολύ κόπο και έτσι έχουμε κέρδος. Μάλιστα το κέρδος εμφανίζεται και όταν η ρουτίνα προχωράει σε βάθος, σε μικρότερες λίστες.

Στη προσθήκη χρησιμοποιώ μεταβλητές που θα χρησιμοποιηθούν διαφορετικά στον αλγόριθμο, για να κερδίσω σε ταχύτητα αλλά και σε μνήμη μεταβλητών.


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