Improved line sort
These macros offer several improvements over the bubblesort line sorting macro submitted by Harald Mueller.
The improvements include:
The sorting is done off-screen in an array, which boosts the speed tremendously. Mueller's sorting implementation "bubbles" the lines directly in the file, so the bottleneck of his macro is in screen redrawing, not in his choice of algorithm.
The algorithm used is QuickSort, which has O(n log n) complexity. Mueller uses BubbleSort, which has O(n^2) complexity.
This implementation allows you to ignore case when sorting.
This implementation allows you to ignore leading and trailing whitespace when sorting.
Mueller's implementation also contains a bug that occurs when you have chosen to disable editing of read-only files and you try to sort a read-only file. Since he does not build an internal representation of the lines (he sorts right in the document), the lines in the read-only file are never put in the correct order, and the sorting loop never exits.
That having been said, Mueller's implementation has some advantages over mine:
His implementation should handle arbitrarily large selections because he does not store all the lines in memory. My implementation will fail for large selections, because it tries to store the entire selection in memory. I have verified that my implementation seems to fail with selections of around 500 lines. I don't know whether this is because of an array size limitation or whether it is dependent on the length (in bytes) of the selection.
With Mueller's approach, one can see the bubble sorting happening on the screen, which is rather entertaining and, for intro-Comp. Sci majors, edifying.
Without further ado, here is the code. There are three routines:
CollectLines, which takes a selection and returns a VBScript array containing all the lines of the selection.
QuickSort, which takes an array and some bounds and sorts the array recursively.
SortLines, which is the framework that does some verification on the document and then calls CollectLines and QuickSort, and then rewrites the sorted output.
Function CollectLines(Selection)
'-- make sure the top of the selection is really the top
StartLine = Selection.TopLine
EndLine = Selection.BottomLine
If EndLine < StartLine Then
Temp="StartLine"
StartLine="EndLine"
EndLine="Temp"
End If
Dim lines() '-- don't try to collect an empty selection
If StartLine > EndLine Then
Redim lines(0)
CollectLines = lines
Exit Function
End If
'-- collect all the lines of the selection into an array
'-- this could be prohibitive on large selections ( > 2M ? )
Redim lines(EndLine - StartLine)
For i = StartLine To EndLine > Selection.GoToLine i
Selection.SelectLine
lines(endLine - i) = Selection.Text
Next
CollectLines = lines
End Function
'-- An internal routine To sort an array
'-- Specify ignoreWhiteSpace = True To ignore leading and trailing whitespace
'-- Specify ignoreCase = True To compare strings ignoring case
Sub QuickSort(vec,loBound,hiBound,ignoreWhiteSpace,ignoreCase)
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
'-- 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 correct loSwap
vecLoSwap = vec(loSwap)
If (ignoreCase = 1 And ignoreWhitespace = 1) Then
While loSwap < hiSwap and ucase(trim(vec(loSwap))) <= ucase(trim(pivot))
loSwap = loSwap + 1
wend
Elseif (ignoreCase = 1) Then
While loSwap < hiSwap and ucase(vec(loSwap)) <= ucase(pivot)
loSwap = loSwap + 1
wend
Elseif (ignoreWhiteSpace = 1) Then
While loSwap < hiSwap and trim(vec(loSwap)) <= trim(pivot)
loSwap = loSwap + 1
wend
Else
While loSwap < hiSwap and vec(loSwap) <= pivot
loSwap = loSwap + 1
wend
End If
'-- find the correct hiSwap
If (ignoreCase = 1 And ignoreWhitespace = 1) Then
While ucase(trim(vec(hiSwap))) > ucase(trim(pivot))
hiSwap = hiSwap - 1
wend
Elseif (ignoreCase = 1) Then
While ucase(vec(hiSwap)) > ucase(pivot)
hiSwap = hiSwap - 1
wend
Elseif (ignoreWhiteSpace = 1) Then
While trim(vec(hiSwap)) > trim(pivot)
hiSwap = hiSwap - 1
wend
Else
While vec(hiSwap) > pivot
hiSwap = hiSwap - 1
wend
End If
'-- swap values if out of order
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 sort the partitions
'-- if there are 2 or more items in first partitions
If loBound < (hiSwap - 1) Then
Call QuickSort(vec,loBound,hiSwap-1,ignoreWhiteSpace, ignoreCase)
End If
'-- 2 or more items in second section
If hiSwap + 1 < hibound Then
Call QuickSort(vec,hiSwap+1,hiBound, ignoreWhiteSpace, ignoreCase)
End If
End Sub
Sub SortLines
'DESCRIPTION: Sorts the selected lines
If ActiveDocument.Type <> "Text" Then
MsgBox "This macro can only be run when a text editor window is active."
Exit Sub
End If
'-- make sure the top of the selection is really the top
StartLine = ActiveDocument.Selection.TopLine
EndLine = ActiveDocument.Selection.BottomLine
If EndLine < StartLine Then
Temp = StartLine
StartLine = EndLine
EndLine = Temp
End If
'-- collect the lines of the selection into an array
lines = CollectLines(ActiveDocument.Selection)
If isnull(lines) Then
Exit Sub
End If
If (ubound(lines) <= 0) Then
'-- don't try to sort an empty selection
Exit Sub
End If
'-- sort the array
Call QuickSort (lines, lbound(lines), ubound(lines), 0, 0)
'-- select the entire original selection, then delete it
ActiveDocument.Selection.GoToLine StartLine
ActiveDocument.Selection.LineDown dsExtend, (EndLine - StartLine) + 1
ActiveDocument.Selection.Delete
'-- write the sorted lines out to the file
For i = 0 To EndLine - StartLine
ActiveDocument.Selection = lines(i)
Next
End Sub
Date Posted: May 13, 1999