## Thursday, October 20, 2005

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