1

vbScript - Sorting With and Without Code

Please see my post vbScript - The Basics for more details on vbScript.

Sorting is something that must be done from time to time. I'm going to examine three ways. The first is the well known (at least by name) QuickSort method. Rather than repeating existing explanations of the actual algorithm I'll just refer you to the Wikipedia QuickSort article and present the code with comments below.

The second method uses a binary tree. The concept is simple even if the implementation is a little difficult to grasp initially. We start with the idea of a node. A node is just a block of data which will contain three important pieces of information. The first is a value (in our case, an item of whatever we sorting). The other two pieces are indicators (pointers) to any subtrees to the left and/or right. Imagine a pyramid with one box at the top and two boxes below that, one to the left and one to the right. Now imagine that each of the lower boxes is its own tree with possibly two boxes below that, and so on.

The idea is that the first item we want to sort will go at the top of the tree. The next item will be either less than the first item, in which case we add it to the left of the tree, greater than the first item, in which case we add it to the right, or equal, in which case, oh dear. So we add another piece of information to the node. It will be a count of how many of each item we have. So if the second item is the same as the first we just add one to the count.

But what if there is already an item to the left or right? In that case we just treat the left or right node as the top of a tree and do the same test again. At some point we will get to the end of the tree and we can add a new node with the given value.

Here's where we get to the part that can give newbies trouble. Recursion. The top node may or may not be the lowest value. What we do know is that if there is a lower value, it must be to the left of the top node, so we go left and find the same conditions - if there is a lower value than that node it must be to the left, and so on and so on. So the output algorithm becomes

Output everything to the left of the current node
Output the current node
Output everything to the right of the current node

It's elegant once you wrap your mind around it. One last thing I should mention - in vbScript you can define objects using Class and End Class and add properties and methods (either public or private). If you want to go by the book you can define get, set and let functions for the properties, or if you are lazy (like me) or disciplined (like me) you can just make the properties public. It's certainly clearer to read.

To test the bitree.vbs code I suggest you create a file, test.txt, that contains the lines

the
quick
brown
fox
jumped
over
the
lazy
lazy
white
dog

Then you can run bitree.vbs by

bitree test.txt
bitree test.txt /verbose

The second method will result in a lot more output but will explain in more detail what is happening. To help you can draw the tree on a piece of paper and match the actions shown in the /verbose output.

The third method requires almost no coding whatsoever. The .net core library provides a number of collection objects that you can create as needed in vbScript. One of these is the ArrayList. Using this object you can add items (of any type, including objects) without having to predetermine an array size, or redimension on the fly. The object provides a Sort method. Here is an example.

Set arr = CreateObject("System.Collections.ArrayList")

arr.Add "the"
arr.Add "quick"
arr.Add "brown"
arr.Add "fox"
arr.Add "jumped"
arr.Add "over"
arr.Add "the"
arr.Add "lazy"
arr.Add "dog"

WScript.Echo ""
WScript.Echo "List the items in storage order"
WScript.Echo ""

For Each item In arr
    WScript.Echo  item
Next

WScript.Echo ""
WScript.Echo "Sort the array and output"
WScript.Echo ""

arr.Sort()

For Each item In arr
    WScript.Echo  item
Next

There is a similar object, SortedArray. This collection is similar to a Dictionary except that unlike a Dictionary, the keys are maintained in sorted order. That means that you can add items in any order and when you iterate through the keys they will always be in sorted order.

Check out System.Collections for a more complete list of objects. Note that not all methods and properties are available in vbScript.

''#region Header                                                                        '
''                                                                                      '
''  Name:                                                                               '
''                                                                                      '
''      QuickSort.vbs                                                                   '
''                                                                                      '
''  Description:                                                                        '
''                                                                                      '
''      Sort an array using the QuickSort algorithm.                                    '
''                                                                                      '
''  Usage:                                                                              '
''                                                                                      '
''      QuickSort(array,compare)                                                        '
''                                                                                      '
''          array:      a one dimensional array of data                                 '
''          compare:    one line of vbscript code which will evaluate to True           '
''                      if the first item of a pair <= the second item                  '
''                                                                                      '
''          Because QuickSort can be used to sort any type of data, you must provide    '
''          the smarts for how to compare two items. QuickSort can then create the      '
''          test function at run time. Your only restriction is that you must refer     '
''          to the two comparison values as X1 and X2. The comparison value should      '
''          return True only if X1 < X2.                                                '
''                                                                                      '
''  Notes:                                                                              '
''                                                                                      '
''      For a detailed description of the QuickSort algorithm and history please see    '
''      https://en.wikipedia.org/wiki/Quicksort                                         '
''                                                                                      '
''  Example:                                                                            '
''                                                                                      '
''      arr = Array(19,3,17,42,-9)                                                      '
''      QuickSort arr, "X1 < X2"                                                        '
''                                                                                      '
''  Audit:                                                                              '
''                                                                                      '
''      2018-02-15  rj  original code                                                   '
''                                                                                      '
''#endregion                                                                            '

Sub QuickSort(arr(), Compare)

    'Create test function then call QuickSort2 to sort

    ExecuteGlobal "Function QuickSort1(X1, X2): QuickSort1 = " & Compare & ": End Function"
    QuickSort2 arr, LBound(arr), UBound(arr)

End Sub

''                                                                                      '
Sub QuickSort2 (arr, arrMin, arrMax)

    Dim middle      'value of the element in the middle of the range    '
    Dim swap        'temporary item for the swapping of two elements    '
    Dim arrFrst     'index of the first element in the range to check   '
    Dim arrLast     'index of the last element in the range to check    '
    Dim arrMid      'index of the element in the middle of the range    '

    If arrMax <= arrMin Then Exit Sub

    'Start the checks at the lower and upper limits of the Array

    arrFrst = arrMin
    arrLast = arrMax

    'Find the midpoint of the region to sort and the value of that element

    arrMid = (arrMin + arrMax) \ 2
    middle = arr(arrMid)

    Do While (arrFrst <= arrLast)

        'Find the first element > the element at the midpoint

        Do While QuickSort1(arr(arrFrst), middle)
            arrFrst = arrFrst + 1
            If arrFrst = arrMax Then Exit Do
        Loop

        'Find the last element < the element at the midpoint

        Do While QuickSort1(middle, arr(arrLast))
            arrLast = arrLast - 1
            If arrLast = arrMin Then Exit Do
        Loop

        'Pivot the two elements around the midpoint if they are out of order

        If (arrFrst <= arrLast) Then
            swap = arr(arrFrst)
            arr(arrFrst) = arr(arrLast)
            arr(arrLast) = swap
            arrFrst = arrFrst + 1
            arrLast = arrLast - 1
        End If

    Loop

    'Sort sub-regions (recurse) if necessary

    If arrMin  < arrLast Then QuickSort2 arr, arrMin,  arrLast
    If arrFrst < arrMax  Then QuickSort2 arr, arrFrst, arrMax

End Sub

''Test code                                                                             '
If StrComp(Wscript.ScriptName,"QuickSort.vbs",vbTextCompare) = 0 Then
    arr = Array(1,99,5,2,73,23,18,92,63,52,52,12,6)
    WScript.Echo Join(arr,vbTab)
    QuickSort arr, "X1 < X2"
    WScript.Echo Join(arr,vbTab)
End If





''#region Header                                                                        '
''                                                                                      '
''  Name:                                                                               '
''                                                                                      '
''      BiTree.vbs                                                                      '
''                                                                                      '
''  Description:                                                                        '
''                                                                                      '
''      This script reads a given file and sorts the lines.                             '
''                                                                                      '
''      This script gives an example of several things. It shows how to define a class  '
''      using script as well as how to sort using a binary tree. It also shows how      '
''      recursion can be used to write very tight and very clear code.                  '
''                                                                                      '
''  Usage:                                                                              '
''                                                                                      '
''      The text file to sort is given on the command line. Output is to the console.   '
''                                                                                      '
''  Audit:                                                                              '
''                                                                                      '
''      2005-03-02  rj  original code                                                   '
''                                                                                      '
''#endregion                                                                            '

If Wscript.Arguments.Count = 0 Then
   Wscript.Echo "BiTree sortfile [/verbose]"
   Wscript.Quit
End If

Set MyTree = New BiTree
MyTree.Debug = WScript.Arguments.Named.Exists("verbose")

'Get the file name from the command line and see if it exists

sortfile = Wscript.Arguments(0)
Set fso = CreateObject("Scripting.FileSystemObject")

If not fso.FileExists(sortfile) Then
   Wscript.Echo "file",sortfile,"not found"
   Wscript.Quit
End If

'Read the entire file and split into separate lines. By first deleting vbCr, then
'splitting on vbLf we guarantee that the splitting will work on files in both the
'Linux (vbLf) and Windows (vbCrLf) text format.

file = fso.OpenTextFile(sortfile,1).ReadAll
file = Split(Replace(file,vbCr,""),vbLf)

'Add all non-blank lines to the binary tree

For Each line In file
   If len(line) > 0 Then MyTree.Add line
Next

'Traverse the tree to display sorted data

WScript.Echo VbCrLf & "Walk In Order"   & VbCrLf & "============="   & VbCrLf
MyTree.WalkInOrder
WScript.Echo ""

''                                                                                      '
''  Class:                                                                              '
''                                                                                      '
''      TreeNode                                                                        '
''                                                                                      '
''  Description:                                                                        '
''                                                                                      '
''      This class implements one node of a binary tree.                                '
''                                                                                      '
''  Properties:                                                                         '
''                                                                                      '
''      LeftChild:    the address of the node to the left (or Nothing)                  '
''      RightChild:   the address of the node to the right (or Nothing)                 '
''      Value:        the data stored in the node                                       '
''      Count:        the number of occurences of the data (in case of duplicates)      '
''                                                                                      '
''  Note:                                                                               '
''                                                                                      '
''      For now, the node value can only be a simple data type (as in one that can be   '
''      used in a simple if-then-else test to determine ordinality).                    '
''                                                                                      '

Class TreeNode             'implementation of a binary tree node                        '

   Public LeftChild        'pointer to the node to the left (or Nothing)                '
   Public RightChild       'pointer to the node to the right (or Nothing)               '
   Public Value            'the data stored in the node                                 '
   Public Count            'number of occurrences of the data (in case of duplicates)   '

   Private Sub Class_Initialize ()
      Set LeftChild  = Nothing
      Set RightChild = Nothing
      Count = 1
   End Sub

   Private Sub Class_Terminate ()
      wscript.echo "Deallocating node",Value
   End Sub

End Class

''                                                                                      '
''  Class:                                                                              '
''                                                                                      '
''      BiTree                                                                          '
''                                                                                      '
''  Description:                                                                        '
''                                                                                      '
''      This class implements a binary tree                                             '
''                                                                                      '
''  Properties:                                                                         '
''                                                                                      '
''      Debug:                  set to true to enable debug output to console           '
''                                                                                      '
''  Methods:                                                                            '
''                                                                                      '
''      Add(newValue)           add the given value in sorted order                     '
''      Find(value)             return the node with the given value (or Nothing)       '
''      WalkInOrder()           dump the tree in sorted order (left-curr-right)         '
''      WalkPreOrder()          dump the tree in prefix order (curr-left-right)         '
''      WalkPostOrder()         dump the tree in postfix order (left-right-curr)        '
''      Count()                 return the number of nodes in the tree                  '
''                                                                                      '

Class BiTree               'implementation of a binary tree                             '

   Private m_root          'this is the node that is at the root of the tree            '
   Private m_valueToAdd    'save value-to-add in a class variable to save stack space   '
   Private m_count         'the number of nodes in the tree                             '
   Public  Debug           'true=debug on  false=debug off                              '

   'Set the root node to Nothing to indicate a null tree

   Private Sub Class_Initialize ()
      Set m_root = Nothing
      m_count = 0
      Debug = False
   End Sub

   Private Sub Class_Terminate ()
      wscript.echo "Deallocating BiTree"
   End Sub

   'Return the number of nodes in the tree

   Public Function Count ()
      Count = m_count
   End Function

   'Add the given value into the tree

   Public Sub Add ( newValue )
      If Debug Then m_Display "  add '" & newValue & "' to the tree"
      m_valueToAdd = newValue          'copy to class variable to minimize stack use    '
      Call m_AddNode(m_root)           'add the value to the tree                       '
      m_count = m_count + 1            'increment the number of nodes                   '
   End Sub

   'Add the data in the class level variable m_valueToAdd into the tree. If this piece  '
   'of data does not already exist in the tree then a new node is allocated, otherwise  '
   'we just increment a counter in the node that contains the data.                     '
   '                                                                                    '
   'Note that adding the data requires traversing the tree. Since each node can be      '
   'treated as the root of a new sub-tree, the AddNode method can call itself until     '
   'either a node with the new data is found or we "fall off" the tree, in which case   '
   'we just allocate a new node and stuff in the data and "attach" it to the tree at    '
   'the point where we fell off.                                                        '

   Private Function m_AddNode ( currNode )

      'One of four things will happen here                                              '
      '                                                                                 '
      '  1) the current node is Nothing (we fell off the tree)                          '
      '  2) the new data is less than the current node data (we have to go left)        '
      '  3) the new data is greater than the current node data (we have to go right)    '
      '  4) the new data is equal to the current node data (we increment the counter)   '

      Select Case True

         Case currNode Is Nothing

            '1) we fell off the tree - allocate a new node

            If Debug Then m_Display "    add node"
            Set currNode   = New TreeNode
            currNode.Value = m_valueToAdd

         Case m_valueToAdd < currNode.Value

            '2) new value < curr value - go Left

            If Debug Then m_Display "    go  left  at '" & currNode.Value & "'"
            Set currNode.LeftChild = m_AddNode(currNode.LeftChild)

         Case m_valueToAdd > currNode.Value

            '3) new value > curr value - go right

            If Debug Then m_Display "    go  right at '" & currNode.Value & "'"
            Set currNode.RightChild = m_AddNode(currNode.RightChild)

         Case m_valueToAdd = currNode.Value

            '4) new value = curr value - increment Count

            If Debug Then m_Display "    increment count"
            currNode.Count = currNode.Count + 1

      End Select

      'return the current node in case we have to attach it to the tree

      Set m_AddNode = currNode

   End Function

   'Print out the tree in sorted order

   Public Sub WalkInOrder ()
      Call m_InOrder(m_root)
   End Sub

   'Print out the tree in prefix order

   Public Sub WalkPreOrder ()
      Call m_PreOrder(m_root)
   End Sub

   'Print out the tree in postfix order

   Public Sub WalkPostOrder ()
      Call m_PostOrder(m_root)
   End Sub

   '  Print out a tree from the given node down in sorted order.                        '
   '                                                                                    '
   '    1) print all values less than the current value (everything to the left)        '
   '    2) print out the current value                                                  '
   '    3) print out values greater than the current value (everything to the right)    '

   Private Sub m_InOrder ( currNode )
      If Not currNode Is Nothing Then
         Call m_InOrder(currNode.LeftChild)
         m_Display "(" & currNode.Count & ") " & currNode.Value
         Call m_InOrder(currNode.RightChild)
      End If
   End Sub

   '  Print out a tree from the given node down in prefix order.                        '
   '                                                                                    '
   '    1) print out the current value                                                  '
   '    2) print all values less than the current value (everything to the left)        '
   '    3) print out values greater than the current value (everything to the right)    '

   Private Sub m_PreOrder ( currNode )
      If Not currNode Is Nothing Then
         m_Display "(" & currNode.Count & ") " & currNode.Value
         Call m_PreOrder(currNode.LeftChild)
         Call m_PreOrder(currNode.RightChild)
      End If
   End Sub

   '  Print out a tree from the given node down in postfix order                        '
   '                                                                                    '
   '    1) print all values less than the current value (everything to the left)        '
   '    2) print out values greater than the current value (everything to the right)    '
   '    3) print out the current value                                                  '

   Private Sub m_PostOrder ( currNode )
      If Not currNode Is Nothing Then
         Call m_PostOrder(currNode.LeftChild)
         Call m_PostOrder(currNode.RightChild)
         m_Display "(" & currNode.Count & ") " & currNode.Value
      End If
   End Sub

   'Print out a string

   Private Sub m_Display ( text )
      wscript.Echo text
   End Sub

End Class

Computer languages in which I have developed applications

Assembler (DEC, Data General, 8080, GE, SEL, IBM 360)
WATFOR (Waterloo FORTRAN)
FORTRAN (SEL)
APL (IBM 360, IBM VSAPL)
PL/1
C/C++
Borland Paradox
VB.net
vbScript

1
Contributor
0
Replies
10
Views
Have something to contribute to this discussion? Please be thoughtful, detailed and courteous, and be sure to adhere to our posting rules.