[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.

[VBScript] Arrrghh!! Sorting out sorting ...

Just when I thought my problems were all over ... or at least the sorting ones ... I found that my machine didn't have enough virtual memory to handle the sort using ADODB (and I don't have the privilege level to do anything about it).

So I ported a heap sort to VBScript and ... so far ... everything look like it's going to work.

Here's the code 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 while n > 1 n = n - 1 exchange 0, n downheap 0 wend end sub private sub buildheap() dim v for v = int( n / 2 ) - 1 to 0 step -1 downheap v next '~ for (int v=n/2-1; v>=0; v--) '~ downheap (v); end sub private sub downheap(v) dim w w = 2 * v + 1 '// first descendant of v 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 wend end sub private sub exchange(i, j) dim t t = aVector( i ) aVector( i ) = aVector( j ) aVector( j ) = t end sub end class ... and to use it, something like this ... Set oHeap = New HeapSorter oHeap.sort aVector aSortedVector = oHeap.sorted()