[VBScript] Shell and Heap Sorts

The final versions of the Shell sort and Heap sort classes. First the ShellSorter:

class ShellSorter 
'~ http://www.iti.fh-flensburg.de/lang/algorithmen/sortieren/shell/shell.htm
    private a
    private n

    public sub sort(a0)
        a = a0
        n = UBound( a ) + 1
        shellsort
    end sub

    public function sorted()
        sorted = a
    end function

    private sub shellsort()
        dim i, j, k, h, t
        dim cols
        cols = array( 1391376, 463792, 198768, 86961, 33936, _
                    13776, 4592, 1968, 861, 336, 112, 48, 21, 7, 3, 1 )
        
        for k = 0 to UBound( cols )
            h = cols( k )
            for i = h to n - 1
                j = i
                t = a( i )
                do while j >= h
                    if a( j - h ) <= t then exit do
                    a( j ) = a( j - h )
                    j = j - h
                loop
                a( j ) = t
            next
        next
    end sub
end class

and then the HeapSorter

class HeapSorter 
    '~ http://www.iti.fh-flensburg.de/lang/algorithmen/sortieren/heap/heapen.htm
    private aVector
    private n

    public sub sort( aVec )
        aVector = aVec
        n = UBound( aVector ) + 1
        heapsort
    end sub

    public function sorted()
        sorted = aVector
    end function

    private sub heapsort()
        buildheap
        do while n > 1
            n = n - 1
            exchange 0, n
            downheap 0
        loop
    end sub

    private sub buildheap()
        dim v
        for v = int( n / 2 ) - 1 to 0 step -1
            downheap v
        next
    end sub

    private sub downheap(v)
        dim w
        w = 2 * v + 1   '// first descendant of v
        do while w < n
            if w + 1 < n then   '// is there a second descendant?
                if aVector( w + 1 ) > aVector( w ) then
                    w = w + 1
                end if
            end if

            '// w is the descendant of v with maximum label
            if aVector( v ) >= aVector( w ) then
                exit sub  '// v has heap property
            end if

            '// otherwise
            exchange v, w  '// exchange labels of v and w
            v = w          '// continue
            w = 2 * v + 1
        loop
    end sub

    private sub exchange(i, j)
        dim t
        t = aVector( i )
        aVector( i ) = aVector( j )
        aVector( j ) = t
    end sub

end class

By the way, I'm unemployed again. Things might be a bit quiet around here for a while.

[VScript] At last, a working shell sort

Finally found a shell sort that works. The problems I had previously might have been had because of this: while (j>=h && a[j-h]>t) I converted that straight to VBScript and kept crashing because a[j-h] with a negative index would get evaluated. By using a do/loop and breaking the test up into two parts do if j < h then exit do end if if a( j - h ) <= t then exit do end if ... I got stuff to work. Here's the code. Usage is similar to that for heap sort. class ShellSorter '~ http://www.iti.fh-flensburg.de/lang/algorithmen/sortieren/shell/shell.htm private a private n public sub sort(a0) a = a0 n = UBound( a ) + 1 shellsort end sub public function sorted() sorted = a end function private sub shellsort() dim i, j, k, h, t dim cols cols = array( 1391376, 463792, 198768, 86961, 33936, _ 13776, 4592, 1968, 861, 336, 112, 48, 21, 7, 3, 1 ) for k = 0 to UBound( cols ) h = cols( k ) i = h do if i >= n then exit do end if j = i t = a( i ) do if j < h then exit do end if if a( j - h ) <= t then exit do end if a( j ) = a( j - h ) j = j - h loop a( j ) = t i = i + 1 loop next end sub end class

[VBScript] allsorts (not licorice)

Assorted sorts. I figured out I didn't need them after all. The BubbleSort is the slowest on large datasets. Sub BubbleSort( arr ) dim arr_j, arr_j1, i, j, temp for i = UBound(arr) - 1 To 0 Step -1 for j = 0 to i arr_j = arr( j ) arr_j1 = arr( j + 1 ) if arr_j > arr_j1 then temp=arr_j1 arr(j+1)=arr_j arr(j)=temp end if next next End Sub Sub QuickSort(vec,loBound,hiBound) Dim pivot,loSwap,hiSwap,temp '== This procedure is adapted from the algorithm given in: '== Data Abstractions & Structures using C++ by '== Mark Headington and David Riley, pg. 586 '== Quicksort is the fastest array sorting routine for '== unordered arrays. Its big O is n log n '~ http://4guysfromrolla.com/webtech/012799-2.shtml '== Two items to sort if hiBound - loBound = 1 then if vec(loBound) > vec(hiBound) then temp=vec(loBound) vec(loBound) = vec(hiBound) vec(hiBound) = temp End If End If '== Three or more items to sort pivot = vec(int((loBound + hiBound) / 2)) vec(int((loBound + hiBound) / 2)) = vec(loBound) vec(loBound) = pivot loSwap = loBound + 1 hiSwap = hiBound do '== Find the right loSwap while loSwap < hiSwap and vec(loSwap) <= pivot loSwap = loSwap + 1 wend '== Find the right hiSwap while vec(hiSwap) > pivot hiSwap = hiSwap - 1 wend '== Swap values if loSwap is less then hiSwap if loSwap < hiSwap then temp = vec(loSwap) vec(loSwap) = vec(hiSwap) vec(hiSwap) = temp End If loop while loSwap < hiSwap vec(loBound) = vec(hiSwap) vec(hiSwap) = pivot '== Recursively call function .. the beauty of Quicksort '== 2 or more items in first section if loBound < (hiSwap - 1) then Call QuickSort(vec,loBound,hiSwap-1) '== 2 or more items in second section if hiSwap + 1 < hibound then Call QuickSort(vec,hiSwap+1,hiBound) End Sub 'QuickSort Function ShellSort( ArrayToSort ) '~ http://www.adit.co.uk/html/a_question_of_sorts.html Dim SortLoop, ShellPoint Dim HoldValue, SortPoint ShellPoint = Lbound(ArrayToSort) Do Until ShellPoint > Ubound(ArrayToSort) ShellPoint = (3 * ShellPoint) + 1 Loop Do Until ShellPoint = Lbound(ArrayToSort) ShellPoint = ShellPoint / 3 For SortLoop = (ShellPoint + LBound(ArrayToSort)) To Ubound(ArrayToSort) HoldValue = ArrayToSort(SortLoop) SortPoint = SortLoop Do While (ArrayToSort(SortPoint - ShellPoint) > HoldValue) ArrayToSort(SortPoint) = ArrayToSort(SortPoint - ShellPoint) SortPoint = SortPoint - ShellPoint If SortPoint < ShellPoint Then Exit Do End If Loop ArrayToSort(SortPoint) = HoldValue Next Loop ShellSort = True End Function

[VBScript] Sorting agonies

After hours spent trying this algorithm and that algorithm, trying Bubble sort (too slow for my massive datasets), QuickSort (which dies from lack of stack space), and ShellSort (which runs at least), I finally stumble over something completely different: Sorting Data by Using a Disconnected Recordset.

After you read the Microsoft blurb, check out what DevGuru has to say about .Sort: PROPERTY: Recordset::Sort.

It's good, but sometimes it seems I spend ages looking for something on the 'net, implementing what I find and then stumble over what I needed in the first place when looking for something else. Aarrrgghh!

To cap the whole episode off, I find I don't need a sort at all! Access will actually protect its indexes whether I "SELECT * FROM" or whether I "SELECT TOP 1 * FROM".

"I'm a teapot, I'm a teapot ..."